├── .RData ├── .Rbuildignore ├── .github ├── .gitignore └── workflows │ ├── R-CMD-check.yaml │ ├── pkgdown.yaml │ └── test-coverage.yaml ├── .gitignore ├── DESCRIPTION ├── LICENSE.md ├── NAMESPACE ├── NEWS.md ├── R ├── as_fc.R ├── fc_draw.R ├── fc_export.R ├── fc_filter.R ├── fc_merge.R ├── fc_modify.R ├── fc_split.R ├── fc_stack.R ├── fc_theme.R ├── fc_view.R ├── safo.R └── utils.R ├── README.md ├── _pkgdown.yml ├── codecov.yml ├── data-raw └── flowchart_example.gif ├── data └── safo.rda ├── flowchart.Rproj ├── man ├── as_fc.Rd ├── fc_draw.Rd ├── fc_export.Rd ├── fc_filter.Rd ├── fc_merge.Rd ├── fc_modify.Rd ├── fc_split.Rd ├── fc_stack.Rd ├── fc_theme.Rd ├── fc_view.Rd ├── figures │ ├── Thumbs.db │ └── logo.png ├── is_class.Rd ├── quiet_prettyNum.Rd ├── replace_num_in_expr.Rd ├── safo.Rd ├── update_numbers.Rd ├── update_x.Rd ├── update_y.Rd ├── update_y_stack.Rd └── update_y_stack_unite.Rd ├── pkgdown └── favicon │ ├── apple-touch-icon.png │ ├── favicon-96x96.png │ ├── favicon.ico │ ├── favicon.svg │ ├── site.webmanifest │ ├── web-app-manifest-192x192.png │ └── web-app-manifest-512x512.png ├── tests ├── testthat.R └── testthat │ ├── Rplots.pdf │ ├── _snaps │ ├── as_fc.md │ ├── fc_draw.md │ ├── fc_export.md │ ├── fc_filter.md │ ├── fc_split.md │ ├── fc_view.md │ └── utils.md │ ├── test-as_fc.R │ ├── test-fc_draw.R │ ├── test-fc_export.R │ ├── test-fc_filter.R │ ├── test-fc_merge.R │ ├── test-fc_modify.R │ ├── test-fc_split.R │ ├── test-fc_stack.R │ ├── test-fc_theme.R │ ├── test-fc_view.R │ ├── test-utils.R │ ├── test.pdf │ └── testthat-problems.rds └── vignettes ├── .gitignore ├── articles ├── .gitignore ├── combine-flowcharts.Rmd ├── example-gallery.Rmd └── flowchart-customization.Rmd └── flowchart.Rmd /.RData: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bruigtp/flowchart/5f107b9abf49513405e4e8311ffe952f6a1a3763/.RData -------------------------------------------------------------------------------- /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^LICENSE\.md$ 4 | ^data-raw$ 5 | ^_pkgdown\.yml$ 6 | ^docs$ 7 | ^pkgdown$ 8 | ^\.github$ 9 | ^doc$ 10 | ^Meta$ 11 | ^vignettes/articles$ 12 | ^codecov\.yml$ 13 | -------------------------------------------------------------------------------- /.github/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | -------------------------------------------------------------------------------- /.github/workflows/R-CMD-check.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | pull_request: 7 | branches: [main, master] 8 | 9 | name: R-CMD-check 10 | 11 | permissions: read-all 12 | 13 | jobs: 14 | R-CMD-check: 15 | runs-on: ubuntu-latest 16 | env: 17 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 18 | R_KEEP_PKG_SOURCE: yes 19 | steps: 20 | - uses: actions/checkout@v4 21 | 22 | - uses: r-lib/actions/setup-r@v2 23 | with: 24 | use-public-rspm: true 25 | 26 | - uses: r-lib/actions/setup-r-dependencies@v2 27 | with: 28 | extra-packages: any::rcmdcheck 29 | needs: check 30 | 31 | - uses: r-lib/actions/check-r-package@v2 32 | with: 33 | upload-snapshots: true 34 | build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")' 35 | -------------------------------------------------------------------------------- /.github/workflows/pkgdown.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | pull_request: 7 | branches: [main, master] 8 | release: 9 | types: [published] 10 | workflow_dispatch: 11 | 12 | name: pkgdown 13 | 14 | jobs: 15 | pkgdown: 16 | runs-on: ubuntu-latest 17 | # Only restrict concurrency for non-PR jobs 18 | concurrency: 19 | group: pkgdown-${{ github.event_name != 'pull_request' || github.run_id }} 20 | env: 21 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 22 | permissions: 23 | contents: write 24 | steps: 25 | - uses: actions/checkout@v4 26 | 27 | - uses: r-lib/actions/setup-pandoc@v2 28 | 29 | - uses: r-lib/actions/setup-r@v2 30 | with: 31 | use-public-rspm: true 32 | 33 | - uses: r-lib/actions/setup-r-dependencies@v2 34 | with: 35 | extra-packages: any::pkgdown, local::. 36 | needs: website 37 | 38 | - name: Build site 39 | run: pkgdown::build_site_github_pages(new_process = FALSE, install = FALSE) 40 | shell: Rscript {0} 41 | 42 | - name: Deploy to GitHub pages 🚀 43 | if: github.event_name != 'pull_request' 44 | uses: JamesIves/github-pages-deploy-action@v4.5.0 45 | with: 46 | clean: false 47 | branch: gh-pages 48 | folder: docs 49 | -------------------------------------------------------------------------------- /.github/workflows/test-coverage.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | pull_request: 7 | 8 | name: test-coverage.yaml 9 | 10 | permissions: read-all 11 | 12 | jobs: 13 | test-coverage: 14 | runs-on: ubuntu-latest 15 | env: 16 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 17 | 18 | steps: 19 | - uses: actions/checkout@v4 20 | 21 | - uses: r-lib/actions/setup-r@v2 22 | with: 23 | use-public-rspm: true 24 | 25 | - uses: r-lib/actions/setup-r-dependencies@v2 26 | with: 27 | extra-packages: any::covr, any::xml2 28 | needs: coverage 29 | 30 | - name: Test coverage 31 | run: | 32 | cov <- covr::package_coverage( 33 | quiet = FALSE, 34 | clean = FALSE, 35 | install_path = file.path(normalizePath(Sys.getenv("RUNNER_TEMP"), winslash = "/"), "package") 36 | ) 37 | print(cov) 38 | covr::to_cobertura(cov) 39 | shell: Rscript {0} 40 | 41 | - uses: codecov/codecov-action@v5 42 | with: 43 | # Fail if error if not on PR, or if on PR and token is given 44 | fail_ci_if_error: ${{ github.event_name != 'pull_request' || secrets.CODECOV_TOKEN }} 45 | files: ./cobertura.xml 46 | plugins: noop 47 | disable_search: true 48 | token: ${{ secrets.CODECOV_TOKEN }} 49 | 50 | - name: Show testthat output 51 | if: always() 52 | run: | 53 | ## -------------------------------------------------------------------- 54 | find '${{ runner.temp }}/package' -name 'testthat.Rout*' -exec cat '{}' \; || true 55 | shell: bash 56 | 57 | - name: Upload test results 58 | if: failure() 59 | uses: actions/upload-artifact@v4 60 | with: 61 | name: coverage-test-failures 62 | path: ${{ runner.temp }}/package 63 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | inst/doc 2 | .Rproj.user 3 | .Rhistory 4 | docs 5 | R/.Rhistory 6 | /doc/ 7 | /Meta/ 8 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: flowchart 2 | Type: Package 3 | Title: Tidy Flowchart Generator 4 | Version: 0.8.0.9002 5 | Authors@R: c( 6 | person("Pau", "Satorra", , "psatorra@igtp.cat", role = c("aut", "cre"), 7 | comment = c(ORCID = "0000-0002-8144-4089")), 8 | person("João", "Carmezim", role = "aut", 9 | comment = c(ORCID = "0009-0009-1443-5578")), 10 | person("Natàlia", "Pallarès", role = "aut", 11 | comment = c(ORCID = "0000-0002-1462-379X")), 12 | person("Cristian", "Tebé", role = "aut", 13 | comment = c(ORCID = "0000-0003-2320-1385")), 14 | person("Kenneth", "Taylor", role = "aut", 15 | comment = c(ORCID = "0000-0002-3205-9280")) 16 | ) 17 | Maintainer: Pau Satorra 18 | Description: Creates participant flow diagrams directly from a dataframe. Representing the flow of participants through each stage of a study, especially in clinical trials, is essential to assess the generalisability and validity of the results. This package provides a set of functions that can be combined with a pipe operator to create all kinds of flowcharts from a data frame in an easy way. 19 | License: GPL (>= 3) 20 | BugReports: https://github.com/bruigtp/flowchart/issues 21 | Encoding: UTF-8 22 | LazyData: true 23 | Imports: 24 | Gmisc, 25 | grid, 26 | tidyr, 27 | dplyr (>= 1.1.0), 28 | purrr, 29 | stringr, 30 | tibble, 31 | tidyselect, 32 | rlang, 33 | grDevices, 34 | cli 35 | Suggests: 36 | knitr, 37 | ragg, 38 | rmarkdown, 39 | testthat (>= 3.0.0), 40 | withr 41 | VignetteBuilder: knitr 42 | Depends: 43 | R (>= 4.1.0) 44 | RoxygenNote: 7.3.2 45 | URL: https://bruigtp.github.io/flowchart/ 46 | Config/testthat/edition: 3 47 | Config/Needs/website: rmarkdown 48 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method(fc_draw,fc) 4 | S3method(fc_export,fc) 5 | S3method(fc_filter,fc) 6 | S3method(fc_modify,fc) 7 | S3method(fc_split,fc) 8 | S3method(fc_view,fc) 9 | export(as_fc) 10 | export(fc_draw) 11 | export(fc_export) 12 | export(fc_filter) 13 | export(fc_merge) 14 | export(fc_modify) 15 | export(fc_split) 16 | export(fc_stack) 17 | export(fc_theme) 18 | export(fc_view) 19 | importFrom(rlang,":=") 20 | importFrom(rlang,.data) 21 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # flowchart 0.1.0 2 | 3 | * Initial CRAN submission. 4 | 5 | # flowchart 0.2.0 6 | 7 | ## Major changes 8 | 9 | * Added new `N=` argument in functions `as_fc()`, `fc_filter()` and `fc_split()` to enter the number of rows manually in case that a dataframe is not available. 10 | 11 | * New `fc_export()` function to export a flowchart in the desired format. 12 | 13 | * Solved bug when performing a split. Now the x-coordinates of the resulting boxes are placed symmetrically around the parent box, not homogeneously distributed across all the space. 14 | 15 | ## Minor changes 16 | 17 | * Added `round_digits=` argument to `fc_filter()` and `fc_split()` functions, which allows to change the number of decimals to round percentages. 18 | 19 | * Added `show_zero=` argument to `fc_split()`, which allows to control whether the groups with zero events should be shown in a box or not. 20 | 21 | * Updated description with minimum R version (>= 4.1.0). 22 | 23 | # flowchart 0.3.0 24 | 25 | ## Major changes 26 | 27 | * Bug in the `fc_split()` function when splitting by a factor with levels that are not arranged in alphabetical order. 28 | 29 | * Bug in the `fc_split()` function when performing multiple splits and showing percentages. These percentages were calculated based on the total number of rows, not the total number of rows in each of the groups defined by the previous splits. 30 | 31 | # flowchart 0.4.0 32 | 33 | ## Major changes 34 | 35 | * Removed `clinic_patient` and `clinic_visit` built-in datasets 36 | 37 | ## Minor changes 38 | 39 | * Changed `safo` built-in dataset 40 | 41 | * Now `unite=FALSE` is the default in the `fc_stack()` function 42 | 43 | * Added `bmp` format to the `fc_export()` function 44 | 45 | # flowchart 0.5.0 46 | 47 | ## Major changes 48 | 49 | * New arguments `text_fface`, `text_ffamily` and `text_padding` to change the font face, font family and padding of the text inside the box 50 | 51 | * New argument `perc_total` to calculate percentages with respect to the total number of rows 52 | 53 | * New argument `offset` to add space to the distance between boxes in a split, and `offset_exc` to add space to the distance from the exclude box in a filter 54 | 55 | * New function `fc_view()` to view the `$fc` element or the `$data` element, associated to a flowchart 56 | 57 | * New argument `title` in the `fc_draw()` function to add a title to a flowchart, along with some additional arguments to customize it 58 | 59 | * New argument `title` in the `fc_split()` function to add a title box in a split, together with some additional arguments to customize it 60 | 61 | * Bug in the exclusion box out of margins 62 | 63 | ## Minor changes 64 | 65 | * Added minimum version for dplyr (>= 1.1.0) 66 | 67 | * Bug in the `fc_export()` function when using the `format` argument 68 | 69 | * Replaced evaluations to tidy evaluations using `rlang::eval_tidy()` 70 | 71 | # flowchart 0.5.1 72 | 73 | * Changed license to GPL (>= 3) license 74 | 75 | # flowchart 0.6.0 76 | 77 | * Added `box_corners` argument to `fc_draw()` to allow drawing boxes with or without round corners; default set to `"round"` to avoid breaking changes (#2; @kenkomodo) 78 | 79 | * Updated `fc_export()` to include vector formats (svg, pdf) and to use `ragg` in place of `grDevices` for relevant bitmap formats (png, jpeg, tiff) for improved performance and image quality when `ragg` is installed (#16; @kenkomodo) 80 | 81 | * Methods for S3 class `fc` correctly defined 82 | 83 | * Bug in the `hide = TRUE` option in `as_fc()` 84 | 85 | * Bug when specifying `sel_group` and `N` at the same time in `fc_split()` 86 | 87 | * Bug when specifying `title` in `fc_split()` with a number of splits different than two 88 | 89 | # flowchart 0.7.0 90 | 91 | * Solved `bug` when `sel_group` is used repeatedly in the same flowchart 92 | 93 | * Changed y-coordinate distribution of boxes when using `fc_stack()` with `unite = TRUE` 94 | 95 | * When performing multiple splits in a flowchart, the group label is stored in `$fc` concatenating the values of the different groups separated by '//' 96 | 97 | * Allow expressions in the label argument to produce bold or italics text, or even formulas 98 | 99 | # flowchart 0.8.0 100 | 101 | * Solved `bug` when `perc_total = TRUE` is used together with `show_exc = TRUE`. 102 | 103 | * Solved `bug` when applying `fc_filter()` in a box with missing values. 104 | 105 | * Added `big.mark` argument to `fc_draw()` to allow users to insert a thousands separator for values of `n` and `N` printed in flowchart boxes (e.g., `big.mark = ","` results in `"1,000"`) (#26; @kenkomodo) 106 | 107 | * Updated package functions to throw warnings using `cli`; added dependency on `cli` (@kenkomodo) 108 | 109 | * Added test suite for package functions (@kenkomodo) 110 | 111 | * Updated `fc_draw()` with `canvas_bg` argument which allows the user to specify the flowchart canvas background color or to set it to `"transparent"` (#30; @kenkomodo) 112 | 113 | * Updated `fc_export()` to accept the new `canvas_bg` argument from `fc_draw()` and apply it accordingly to the exported flowchart image (#30; @kenkomodo) 114 | 115 | * Solved `bug` causing `fc_export()` to drop newer `fc_draw()` arguments when redrawing the flowchart for export (#32; @kenkomodo) 116 | 117 | * New `width` and `height` arguments for `as_fc()`, `fc_filter()` and `fc_split()` functions to manually set the size of boxes. 118 | 119 | 120 | # flowchart (development version) 121 | 122 | * Split up `flowchart` vignette into multiple different articles and updated `_pkgdown.yml` to build `dev` version of site separately while defaulting to currently released CRAN version (#37). 123 | 124 | * Stack flowcharts with `unite=TRUE` if there are more boxes in the last level of the first flowchart than in the first level of the second flowchart. 125 | 126 | * The `text_pattern` argument now allows expressions, so users can now format text other than the label in bold. 127 | 128 | * New `fc_theme()` function to set all parameters for all boxes in a flowchart at once. 129 | -------------------------------------------------------------------------------- /R/as_fc.R: -------------------------------------------------------------------------------- 1 | #' @title as_fc 2 | #' @description This function allows to initialize a flow chart given any database. It will create a fc object showing the number of rows of the database. If a database is not available, the user can instead directly enter the number of rows in the study. 3 | #' 4 | #' @param .data Data frame to be initialised as a flowchart. 5 | #' @param N Number of rows of the study in case `.data` is NULL. 6 | #' @param label Character or expression with the text that will be shown in the box. 7 | #' @param text_pattern Character or expression defining the structure that will have the text in each of the boxes. It recognizes label, n, N and perc within brackets. For default it is "\{label\}\\n \{n\}". If text_pattern or label is an expression, the label is always placed at the beginning of the pattern, followed by a line break where the structure specified by text_pattern is placed. 8 | #' @param just Justification for the text: left, center or right. Default is center. 9 | #' @param text_color Color of the text. It is black by default. See the `col` parameter for \code{\link{gpar}}. 10 | #' @param text_fs Font size of the text. It is 8 by default. See the `fontsize` parameter for \code{\link{gpar}}. 11 | #' @param text_fface Font face of the text. It is 1 by default. See the `fontface` parameter for \code{\link{gpar}}. 12 | #' @param text_ffamily Changes the font family of the text. Default is NA. See the `fontfamily` parameter for \code{\link{gpar}}. 13 | #' @param text_padding Changes the text padding inside the box. Default is 1. This number has to be greater than 0. 14 | #' @param bg_fill Box background color. It is white by default. See the `fill` parameter for \code{\link{gpar}}. 15 | #' @param border_color Box border color. It is black by default. See the `col` parameter for \code{\link{gpar}}. 16 | #' @param width Width of the box. If NA, it automatically adjusts to the content (default). Must be an object of class \code{\link{unit}} or a number between 0 and 1. 17 | #' @param height Height of the box. If NA, it automatically adjusts to the content (default). Must be an object of class \code{\link{unit}} or a number between 0 and 1. 18 | #' @param hide Logical value to hide the initial box or not. Default is FALSE. hide = TRUE can only be combined with fc_split(). 19 | #' 20 | #' @return List with the dataset and the initialized flowchart parameters. 21 | #' 22 | #' @examples 23 | #' safo |> 24 | #' as_fc(label = "Patients assessed for eligibility") |> 25 | #' fc_draw() 26 | #' 27 | #' @export 28 | 29 | as_fc <- function(.data = NULL, N = NULL, label = "Initial dataframe", text_pattern = "{label}\n{N}", just = "center", text_color = "black", text_fs = 8, text_fface = 1, text_ffamily = NA, text_padding = 1, bg_fill = "white", border_color = "black", width = NA, height = NA, hide = FALSE) { 30 | 31 | if(is.null(.data) & is.null(N)) { 32 | cli::cli_abort("Either {.arg .data} or {.arg N} arguments must be specified.") 33 | }else if(!is.null(.data) & !is.null(N)) { 34 | cli::cli_abort("The {.arg .data} and {.arg N} arguments cannot be specified simultaneously.") 35 | } 36 | 37 | if(!is.null(.data)) { 38 | N <- nrow(.data) 39 | } else { 40 | .data <- tibble::tibble(id = 1:N) 41 | } 42 | 43 | if(text_padding == 0) { 44 | cli::cli_abort("Text padding cannot be equal to zero.") 45 | } 46 | 47 | if(!hide) { 48 | 49 | new_fc <- tibble::tibble( 50 | id = 1, 51 | x = 0.5, 52 | y = 0.5, 53 | n = N, 54 | N = N, 55 | perc = "100", 56 | type = "init", 57 | group = NA, 58 | just = just, 59 | text_color = text_color, 60 | text_fs = text_fs, 61 | text_fface = text_fface, 62 | text_ffamily = text_ffamily, 63 | text_padding = text_padding, 64 | bg_fill = bg_fill, 65 | border_color = border_color, 66 | width = width, 67 | height = height, 68 | end = TRUE 69 | ) 70 | 71 | if(is.expression(label) | is.expression(text_pattern)) { 72 | 73 | if(is.expression(text_pattern)) { 74 | 75 | text_pattern_exp <- gsub("\\{label\\}", "", as.character(text_pattern)) |> 76 | stringr::str_glue(.envir = rlang::as_environment(new_fc)) 77 | 78 | text_pattern_exp <- tryCatch( 79 | parse(text = text_pattern_exp), 80 | error = \(e) { 81 | list(as.character(text_pattern_exp)) 82 | }) 83 | 84 | new_fc <- new_fc |> 85 | dplyr::mutate(text = list(substitute(atop(x, y), list(x = label[[1]], y = text_pattern_exp[[1]])))) 86 | 87 | } else { 88 | 89 | text_pattern_exp <- gsub("\\{label\\}", "", text_pattern) 90 | 91 | new_fc <- new_fc |> 92 | dplyr::mutate(text = list(substitute(atop(x, y), list(x = label[[1]], y = stringr::str_glue(text_pattern_exp))))) 93 | 94 | } 95 | 96 | } else if(is.character(label) & is.character(text_pattern)) { 97 | 98 | new_fc <- new_fc |> 99 | dplyr::mutate(text = as.character(stringr::str_glue(text_pattern))) 100 | 101 | } else { 102 | 103 | cli::cli_abort("The {.arg label} and {.arg text_pattern} must be either characters or expressions.") 104 | 105 | } 106 | 107 | 108 | new_fc <- new_fc |> 109 | dplyr::relocate("text", .after = "perc") 110 | 111 | } else { 112 | 113 | cli::cli_warn("{.code hide = TRUE} can only be combined with {.fn fc_split}") 114 | new_fc <- NULL 115 | 116 | } 117 | 118 | #Initialize flowchart as x is a dataframe 119 | object <- list( 120 | data = .data |> 121 | dplyr::ungroup(), 122 | fc = new_fc 123 | ) 124 | 125 | class(object) <- c("fc") 126 | 127 | object 128 | 129 | } 130 | -------------------------------------------------------------------------------- /R/fc_draw.R: -------------------------------------------------------------------------------- 1 | #' @title fc_draw 2 | #' @description This function allows to draw the flowchart from a fc object. 3 | #' 4 | #' @param object fc object that we want to draw. 5 | #' @param big.mark character. Used to specify the thousands separator for patient count values. Defaults is no separator (`""`); if not empty used as mark between every 3 digits (ex: `big.mark = ","` results in `1,000` instead of `1000`). 6 | #' @param box_corners Indicator of whether to draw boxes with round (`"round"`) vs non-round (`"sharp"`) corners. Default is `"round"`. 7 | #' @param arrow_angle The angle of the arrow head in degrees, as in `arrow`. 8 | #' @param arrow_length A unit specifying the length of the arrow head (from tip to base), as in `arrow`. 9 | #' @param arrow_ends One of "last", "first", or "both", indicating which ends of the line to draw arrow heads, as in `arrow`. 10 | #' @param arrow_type One of "open" or "closed" indicating whether the arrow head should be a closed triangle, as in `arrow`. 11 | #' @param title The title of the flowchart. Default is NULL (no title). 12 | #' @param title_x x coordinate for the title. Default is 0.5. 13 | #' @param title_y y coordinate for the title. Default is 0.9. 14 | #' @param title_color Color of the title. It is black by default. See the `col` parameter for \code{\link{gpar}}. 15 | #' @param title_fs Font size of the title. It is 15 by default. See the `fontsize` parameter for \code{\link{gpar}}. 16 | #' @param title_fface Font face of the title. It is 2 by default. See the `fontface` parameter for \code{\link{gpar}}. 17 | #' @param title_ffamily Changes the font family of the title. Default is NA. See the `fontfamily` parameter for \code{\link{gpar}}. 18 | #' @param canvas_bg Background color for the entire canvas (the area behind the flowchart boxes). Default is `"white"`. Set to `"transparent"` or `NULL` for a transparent background; `"transparent"` background will only be noticeable when exporting drawn flowcharts via `fc_export()` and is compatible with all `fc_export()` formats except `"jpeg"` and `"bmp"`. 19 | 20 | #' @return Invisibly returns the same object that has been given to the function, with the given arguments to draw the flowchart stored in the attributes. 21 | #' 22 | #' @examples 23 | #' safo |> 24 | #' as_fc(label = "Patients assessed for eligibility") |> 25 | #' fc_filter(!is.na(group), label = "Randomized", show_exc = TRUE) |> 26 | #' fc_split(group) |> 27 | #' fc_filter(itt == "Yes", label = "Included in ITT") |> 28 | #' fc_filter(pp == "Yes", label = "Included in PP") |> 29 | #' fc_draw() 30 | #' 31 | #' @export 32 | 33 | fc_draw <- function(object, big.mark = "", box_corners = "round", arrow_angle = 30, arrow_length = grid::unit(0.1, "inches"), arrow_ends = "last", arrow_type = "closed", title = NULL, title_x = 0.5, title_y = 0.9, title_color = "black", title_fs = 15, title_fface = 2, title_ffamily = NULL, canvas_bg = "white") { 34 | 35 | is_class(object, "fc") 36 | UseMethod("fc_draw") 37 | 38 | } 39 | 40 | #' @importFrom rlang .data 41 | #' @export 42 | 43 | fc_draw.fc <- function(object, big.mark = "", box_corners = "round", arrow_angle = 30, arrow_length = grid::unit(0.1, "inches"), arrow_ends = "last", arrow_type = "closed", title = NULL, title_x = 0.5, title_y = 0.9, title_color = "black", title_fs = 15, title_fface = 2, title_ffamily = NULL, canvas_bg = "white") { 44 | 45 | # Check for valid corners argument 46 | if (!box_corners %in% c("round", "sharp")) { 47 | cli::cli_abort("The {.arg box_corners} argument must be {.val round} or {.val sharp}.") 48 | } 49 | 50 | if (box_corners == "round") { 51 | rect_type <- grid::roundrectGrob 52 | } else { 53 | rect_type <- grid::rectGrob 54 | } 55 | 56 | #Initialize grid 57 | grid::grid.newpage() 58 | 59 | # Draw background rectangle covering the entire viewport 60 | if (canvas_bg != "transparent" && !is.null(canvas_bg)) { 61 | grid::grid.rect(gp = grid::gpar(fill = canvas_bg, col = NA)) 62 | } 63 | 64 | object0 <- object #to return the object unaltered 65 | 66 | #We have to return the parameters of the function in the attribute of object$fc 67 | params <- c("big.mark", "box_corners", "arrow_angle", "arrow_length", "arrow_ends", "arrow_type", "title", "title_x", "title_y", "title_color", "title_fs", "title_fface", "title_ffamily", "canvas_bg") 68 | attr_draw <- purrr::map(params, ~get(.x)) 69 | names(attr_draw) <- params 70 | 71 | attr(object0$fc, "draw") <- attr_draw 72 | 73 | if(tibble::is_tibble(object$fc)) object$fc <- list(object$fc) 74 | 75 | # Incorporate the update_numbers helper to update text values based on big.mark: 76 | if(big.mark != "") { 77 | object <- update_numbers(object, big.mark = big.mark) 78 | } 79 | 80 | plot_fc <- purrr::map(object$fc, ~.x |> 81 | dplyr::mutate( 82 | #Recalculate row number 83 | id = dplyr::row_number(), 84 | bg = purrr::pmap(list(.data$x, .data$y, .data$text, .data$type, .data$group, .data$just, .data$text_color, .data$text_fs, .data$text_fface, .data$text_ffamily, .data$text_padding, .data$bg_fill, .data$border_color, .data$width, .data$height), function(...) { 85 | arg <- list(...) 86 | names(arg) <- c("x", "y", "text", "type", "group", "just", "text_color", "text_fs", "text_fface", "text_ffamily", "text_padding", "bg_fill", "border_color", "width", "height") 87 | if(!is.na(arg$width) & !is.na(arg$height)) { 88 | 89 | Gmisc::boxGrob(arg$text, x = arg$x, y = arg$y, just = arg$just, txt_gp = grid::gpar(col = arg$text_color, fontsize = arg$text_fs/arg$text_padding, fontface = arg$text_fface, fontfamily = arg$text_ffamily, cex = arg$text_padding), box_gp = grid::gpar(fill = arg$bg_fill, col = arg$border_color), width = arg$width, height = arg$height, box_fn = rect_type) 90 | 91 | } else if(!is.na(arg$width)) { 92 | 93 | Gmisc::boxGrob(arg$text, x = arg$x, y = arg$y, just = arg$just, txt_gp = grid::gpar(col = arg$text_color, fontsize = arg$text_fs/arg$text_padding, fontface = arg$text_fface, fontfamily = arg$text_ffamily, cex = arg$text_padding), box_gp = grid::gpar(fill = arg$bg_fill, col = arg$border_color), width = arg$width, box_fn = rect_type) 94 | 95 | } else if(!is.na(arg$height)) { 96 | 97 | Gmisc::boxGrob(arg$text, x = arg$x, y = arg$y, just = arg$just, txt_gp = grid::gpar(col = arg$text_color, fontsize = arg$text_fs/arg$text_padding, fontface = arg$text_fface, fontfamily = arg$text_ffamily, cex = arg$text_padding), box_gp = grid::gpar(fill = arg$bg_fill, col = arg$border_color), height = arg$height, box_fn = rect_type) 98 | 99 | } else { 100 | 101 | Gmisc::boxGrob(arg$text, x = arg$x, y = arg$y, just = arg$just, txt_gp = grid::gpar(col = arg$text_color, fontsize = arg$text_fs/arg$text_padding, fontface = arg$text_fface, fontfamily = arg$text_ffamily, cex = arg$text_padding), box_gp = grid::gpar(fill = arg$bg_fill, col = arg$border_color), box_fn = rect_type) 102 | 103 | } 104 | 105 | }) 106 | ) 107 | ) 108 | 109 | #Plot the boxes: 110 | for(i in 1:length(plot_fc)) { 111 | for(j in 1:nrow(plot_fc[[i]])) { 112 | print(plot_fc[[i]]$bg[[j]]) 113 | } 114 | } 115 | 116 | #Plot the connections: 117 | for(i in 1:length(plot_fc)) { 118 | 119 | #Identify each step of the process of connecting the flowchart 120 | step <- plot_fc[[i]] |> 121 | dplyr::distinct(.data$y, .data$type) 122 | 123 | if(nrow(step) > 1) { 124 | for(j in 2:nrow(step)) { 125 | ids <- plot_fc[[i]] |> 126 | dplyr::filter(.data$y == step$y[j], .data$type == step$type[j]) |> 127 | dplyr::pull(.data$id) 128 | 129 | type <- unique(plot_fc[[i]][["type"]][ids]) 130 | 131 | if(type == "split") { 132 | 133 | for(k in ids) { 134 | 135 | group_par <- unlist(stringr::str_split(plot_fc[[i]][["group"]][k], " // ")) 136 | group_par <- paste(utils::head(group_par, -1), collapse = " // ") 137 | 138 | #If there is only one group, the parent box is the right before them 139 | if(group_par == "") { 140 | 141 | id_par <- plot_fc[[i]] |> 142 | dplyr::filter(.data$id < min(ids), .data$type != "exclude") |> 143 | dplyr::last() |> 144 | dplyr::pull(.data$id) 145 | 146 | } else { 147 | 148 | id_par <- plot_fc[[i]] |> 149 | dplyr::filter(.data$id < min(ids), .data$group == group_par, .data$type != "exclude") |> 150 | dplyr::last() |> 151 | dplyr::pull(.data$id) 152 | 153 | } 154 | 155 | #If it exists because now the initial box can be hided 156 | if(length(id_par) > 0) { 157 | print(Gmisc::connectGrob(plot_fc[[i]]$bg[[id_par]], plot_fc[[i]]$bg[[k]], type = "N", arrow_obj = getOption("connectGrobArrow", default = grid::arrow(angle = arrow_angle, length = arrow_length, ends = arrow_ends, type = arrow_type)))) 158 | } 159 | 160 | } 161 | 162 | } else if(type == "filter") { 163 | 164 | for(k in ids) { 165 | 166 | #Get the parent box (the last with the same x coordinate) 167 | id <- plot_fc[[i]] |> 168 | dplyr::filter(.data$x == plot_fc[[i]][["x"]][k], .data$id < plot_fc[[i]][["id"]][k]) |> 169 | dplyr::last() |> 170 | dplyr::pull(.data$id) 171 | 172 | #If it exists because now the initial box can be hided 173 | if(length(id) > 0) { 174 | print(Gmisc::connectGrob(plot_fc[[i]]$bg[[id]], plot_fc[[i]]$bg[[k]], type = "vertical", arrow_obj = getOption("connectGrobArrow", default = grid::arrow(angle = arrow_angle, length = arrow_length, ends = arrow_ends, type = arrow_type)))) 175 | } 176 | 177 | } 178 | 179 | } else if(type == "exclude") { 180 | 181 | for(k in ids) { 182 | 183 | print(Gmisc::connectGrob(plot_fc[[i]]$bg[[k - 1]], plot_fc[[i]]$bg[[k]], type = "-", arrow_obj = getOption("connectGrobArrow", default = grid::arrow(angle = arrow_angle, length = arrow_length, ends = arrow_ends, type = arrow_type)))) 184 | 185 | } 186 | 187 | } else if(type == "stack") { 188 | 189 | #Find the ending boxes of the previous flow chart (before stack) 190 | id_last <- plot_fc[[i]] |> 191 | dplyr::filter(dplyr::row_number() < ids[1], .data$end) |> 192 | #Arrange in function of the order they appear in the x-coordinate 193 | dplyr::arrange(.data$x) |> 194 | dplyr::pull(.data$id) 195 | 196 | if(length(id_last) == 1 & length(ids) > 1) { 197 | 198 | for(k in ids) { 199 | 200 | print(Gmisc::connectGrob(plot_fc[[i]]$bg[[id_last]], plot_fc[[i]]$bg[[k]], type = "N", arrow_obj = getOption("connectGrobArrow", default = grid::arrow(angle = arrow_angle, length = arrow_length, ends = arrow_ends, type = arrow_type)))) 201 | 202 | } 203 | 204 | } else if (length(ids) == 1 & length(id_last) > 1) { 205 | 206 | for(k in id_last) { 207 | 208 | print(Gmisc::connectGrob(plot_fc[[i]]$bg[[k]], plot_fc[[i]]$bg[[ids]], type = "L", arrow_obj = getOption("connectGrobArrow", default = grid::arrow(angle = arrow_angle, length = arrow_length, ends = arrow_ends, type = arrow_type)))) 209 | 210 | } 211 | 212 | 213 | } else if (length(ids) == length(id_last)) { 214 | #They have the same number of boxes 215 | for(k in 1:length(ids)) { 216 | #vertical connection 217 | print(Gmisc::connectGrob(plot_fc[[i]]$bg[[id_last[k]]], plot_fc[[i]]$bg[[ids[k]]], type = "vertical", arrow_obj = getOption("connectGrobArrow", default = grid::arrow(angle = arrow_angle, length = arrow_length, ends = arrow_ends, type = arrow_type)))) 218 | } 219 | 220 | } else { 221 | #It should never enter here because of fc_stack() 222 | cli::cli_abort("Flowcharts can't be united because they have a different number of boxes in their connecting levels.") 223 | } 224 | 225 | } 226 | 227 | } 228 | } 229 | 230 | } 231 | 232 | #Plot title 233 | if(!is.null(title)) { 234 | 235 | grid::grid.text(title, x = title_x, y = title_y, gp = grid::gpar(col = title_color, fontsize = title_fs, fontface = title_fface, fontfamily = title_ffamily)) 236 | 237 | } 238 | 239 | invisible(object0) 240 | 241 | } 242 | -------------------------------------------------------------------------------- /R/fc_export.R: -------------------------------------------------------------------------------- 1 | #' @title fc_export 2 | #' @description This function allows you to export the drawn flowchart to the most popular graphic formats, including bitmap formats (png, jpeg, tiff, bmp) and vector formats (svg, pdf). For bitmap formats, it uses the `ragg` package devices when available for higher performance and higher quality output than standard raster devices provide by `grDevices`. 3 | #' 4 | #' @details 5 | #' - **Vector Formats ('svg', 'pdf'):** These formats are ideal for graphics that need to be scaled without loss of quality. The default units for width and height are inches. If user specifies `units` other than inches ("mm" or "cm"), the function will convert the dimensions to inches using standard conversion formulas. 6 | #' - **Bitmap Formats ('png', 'jpeg', 'tiff', 'bmp'):** For these formats (with the exception of 'bmp'), the function uses the `ragg` package devices when available, providing higher performance and higher quality output. The default units for width and height are pixels. 7 | #' - **Suggested Dependencies:** For superior performance and quality bitmap outputs, it is recommended to install the `ragg` package. For exporting to 'pdf' format with enhanced features, the Cairo graphics library will be used if it is available. 8 | #' 9 | #' @param object fc object that we want to export. 10 | #' @param filename File name to create on disk. 11 | #' @param path Path of the directory to save plot to: path and filename are combined to create the fully qualified file name. Defaults to the working directory. 12 | #' @param format Name of the graphic device. One of 'png', 'jpeg', 'tiff', 'bmp', 'svg', or 'pdf'. If `NULL` (default), the format is guessed based on the filename extension. 13 | #' @param width,height Plot size in units expressed by the `units` argument. Default is 600px for bitmap formats and 6 inches for vector formats. 14 | #' @param units One of the following units in which the width and height arguments are expressed: "in", "cm", "mm" for vector formats and "in", "cm", "mm" or "px" for bitmap formats. If left `NULL` (default), the function will automatically use "px" for bitmap formats and "in" for vector formats. 15 | #' @param res The nominal resolution in ppi which will be recorded in the bitmap file, if a positive integer. Also used for units other than the default, and to convert points to pixels. Default is 100 if exporting in bitmap format. This argument is unused if exporting to a vector format. 16 | #' @return Invisibly returns the same object that has been given to the function. 17 | #' 18 | #' @examples 19 | #' \dontrun{ 20 | #' safo |> 21 | #' as_fc(label = "Patients assessed for eligibility") |> 22 | #' fc_filter(!is.na(group), label = "Randomized", show_exc = TRUE) |> 23 | #' fc_draw() |> 24 | #' fc_export("flowchart.png") 25 | #' 26 | #' #Specifying size and resolution 27 | #' safo |> 28 | #' as_fc(label = "Patients assessed for eligibility") |> 29 | #' fc_filter(!is.na(group), label = "Randomized", show_exc = TRUE) |> 30 | #' fc_draw() |> 31 | #' fc_export("flowchart.png", width = 3000, height = 4000, res = 700) 32 | #' 33 | #' #Exporting to an SVG file 34 | #' safo |> 35 | #' as_fc(label = "Patients assessed for eligibility") |> 36 | #' fc_filter(!is.na(group), label = "Randomized", show_exc = TRUE) |> 37 | #' fc_draw() |> 38 | #' fc_export("flowchart.svg") 39 | #' 40 | #' #Exporting to a PDF file 41 | #' safo |> 42 | #' as_fc(label = "Patients assessed for eligibility") |> 43 | #' fc_filter(!is.na(group), label = "Randomized", show_exc = TRUE) |> 44 | #' fc_draw() |> 45 | #' fc_export("flowchart.pdf") 46 | #' } 47 | #' @export 48 | 49 | fc_export <- function(object, filename, path = NULL, format = NULL, width = NA, height = NA, units = NULL, res = 100) { 50 | 51 | is_class(object, "fc") 52 | UseMethod("fc_export") 53 | 54 | } 55 | 56 | #' @importFrom rlang .data 57 | #' @export 58 | 59 | fc_export.fc <- function(object, filename, path = NULL, format = NULL, width = NA, height = NA, units = NULL, res = 100) { 60 | 61 | #Get parameters from the previously drawn object 62 | params <- attr(object$fc, "draw") 63 | if(is.null(params)) { 64 | cli::cli_abort("Object must be created with {.fn fc_draw}.") 65 | } 66 | 67 | #Get format from filename if not specified 68 | if (is.null(format)) { 69 | format <- tolower(tools::file_ext(filename)) 70 | if (identical(format, "")) { 71 | cli::cli_abort("File {.arg filename} has no extension and format is {.code NULL}.") 72 | } 73 | } else { 74 | #Put format to filename if format is specified 75 | format_file <- tolower(tools::file_ext(filename)) 76 | if(identical(format_file, "")) { 77 | filename <- paste0(filename, ".", format) 78 | } else { 79 | if(!identical(format_file, format)) { 80 | cli::cli_abort("{.arg filename} extension and the specified {.arg format} don't match.") 81 | } 82 | } 83 | } 84 | 85 | #If format is not one of 'png', 'jpeg', 'tiff', 'bmp', 'svg', or 'pdf': 86 | valid_formats <- c("png", "jpeg", "tiff", "bmp", "svg", "pdf") 87 | if(! format %in% valid_formats) { 88 | cli::cli_abort( 89 | c("Invalid {.arg format} specified", 90 | "i" = "Valid {.arg format} choices are {.val {valid_formats}}.") 91 | ) 92 | } 93 | 94 | if (!is.null(path)) { 95 | filename <- file.path(path, filename) 96 | } 97 | 98 | # Set default units based on format if units is NULL (default) 99 | if (is.null(units)) { 100 | if (format %in% c("svg", "pdf")) { 101 | units <- "in" 102 | } else { 103 | units <- "px" 104 | } 105 | } 106 | 107 | # Handle units and default dimensions 108 | if (format %in% c("svg", "pdf")) { 109 | # For vector formats, units cannot be 'px' 110 | units_conv <- c("in", "cm", "mm") 111 | if (!(units %in% units_conv)) { 112 | cli::cli_abort("Invalid units for vector formats. Units must be {.or {.val in}, {.val cm}, or {.val mm}}.") 113 | } 114 | # Set default dimensions if missing width in inches and alert user if they specified different unit type 115 | if (is.na(width)) { 116 | width <- 6 117 | if (units != "in") { 118 | cli::cli_warn("If {.arg width} is missing for vector formats ({.val svg}, {.val pdf}), default {.arg width} is 6 inches.") 119 | } 120 | } 121 | # Set default dimensions if missing height in inches and alert user if they specified different unit type 122 | if (is.na(height)) { 123 | height <- 6 124 | if (units != "in") { 125 | cli::cli_warn("If {.arg height} is missing for vector formats ({.val svg}, {.val pdf}), default {.arg height} is 6 inches.") 126 | } 127 | } 128 | # Convert units to inches if necessary 129 | width_in <- switch(units, 130 | "in" = width, 131 | "cm" = width / 2.54, 132 | "mm" = width / 25.4) 133 | height_in <- switch(units, 134 | "in" = height, 135 | "cm" = height / 2.54, 136 | "mm" = height / 25.4) 137 | # Open the appropriate device 138 | if (format == "svg") { 139 | grDevices::svg( 140 | filename = filename, 141 | width = width_in, 142 | height = height_in, 143 | bg = params$canvas_bg # Original default for grDevices::svg() is "white" 144 | ) 145 | } else if (format == "pdf") { 146 | if (capabilities("cairo")) { 147 | grDevices::cairo_pdf( 148 | filename = filename, 149 | width = width_in, 150 | height = height_in, 151 | bg = params$canvas_bg # Original default for grDevices::pdf() is "white" 152 | ) 153 | } else { 154 | cli::cli_warn("Cairo graphics library is not available. Falling back to {.fn grDevices::pdf}.") 155 | grDevices::pdf( 156 | file = filename, 157 | width = width_in, 158 | height = height_in, 159 | bg = params$canvas_bg # Original default for grDevices::pdf() is "transparent" 160 | ) 161 | } 162 | } 163 | } else { 164 | # For bitmap formats, units can be 'in', 'cm', 'mm', or 'px' 165 | units_conv <- c("in", "cm", "mm", "px") 166 | if (!(units %in% units_conv)) { 167 | cli::cli_abort("The {.arg units} for bitmap formats must be {.val in}, {.val cm}, {.val mm}, or {.val px}.") 168 | } 169 | # Set default dimensions if missing 170 | if (is.na(width)) { 171 | width <- 600 172 | if (units != "px") { 173 | cli::cli_warn("If {.arg width} is missing for bitmap formats, default {.arg width} is 600 pixels.") 174 | } 175 | } 176 | if (is.na(height)) { 177 | height <- 600 178 | if (units != "px") { 179 | cli::cli_warn("If {.arg height} is missing for bitmap formats, default {.arg height} is 600 pixels.") 180 | } 181 | } 182 | #Open the bitmap device, using ragg-based devices when available 183 | #Map formats to device functions explicitly 184 | if (format %in% c("png", "jpeg", "tiff")) { 185 | if (rlang::is_installed("ragg")) { 186 | device_fun <- switch(format, 187 | png = ragg::agg_png, 188 | jpeg = ragg::agg_jpeg, 189 | tiff = ragg::agg_tiff) 190 | } else { 191 | cli::cli_warn( 192 | c( 193 | "Defaulting to {.pkg grDevices} package since {.pkg ragg} is not installed.", 194 | "i" = "Consider installing the {.pkg ragg} package for higher quality {.val png}, {.val jpeg}, and {.val tiff} images." 195 | ) 196 | ) 197 | device_fun <- switch(format, 198 | png = grDevices::png, 199 | jpeg = grDevices::jpeg, 200 | tiff = grDevices::tiff) 201 | } 202 | } else { 203 | device_fun <- switch(format, bmp = grDevices::bmp) 204 | } 205 | 206 | # If canvas_bg == "transparent" or NULL and bitmap format supports transparency, set to "transparent" 207 | if (params$canvas_bg == "transparent" || is.null(params$canvas_bg)) { 208 | # Add transparency support for PNG and TIFF 209 | if (format %in% c("png", "tiff")) { 210 | device_fun(filename = filename, width = width, height = height, units = units, res = res, bg = "transparent") 211 | } else { 212 | # JPEG and bmp does not support transparency - warn user and fallback on device default 213 | device_fun(filename = filename, width = width, height = height, units = units, res = res) 214 | cli::cli_warn("The formats {.val jpeg} and {.val bmp} do not support transparent {.arg canvas_bg}, falling back to {.val white}") 215 | } 216 | } else { 217 | # Normal case with a background color ("white" or otherwise) 218 | device_fun(filename = filename, width = width, height = height, units = units, res = res, bg = params$canvas_bg) 219 | } 220 | } 221 | 222 | #Redraw the plot 223 | object |> 224 | fc_draw(big.mark = params$big.mark, box_corners = params$box_corners, arrow_angle = params$arrow_angle, arrow_length = params$arrow_length, arrow_ends = params$arrow_ends, arrow_type = params$arrow_type, title = params$title, title_x = params$title_x, title_y = params$title_y, title_color = params$title_color, title_fs = params$title_fs, title_fface = params$title_fface, title_ffamily = params$title_ffamily, canvas_bg = params$canvas_bg) 225 | 226 | grDevices::dev.off() 227 | 228 | invisible(object) 229 | } 230 | -------------------------------------------------------------------------------- /R/fc_filter.R: -------------------------------------------------------------------------------- 1 | #' @title fc_filter 2 | #' @description This function allows to filter the flowchart in function of a expression that returns a logic value that are defined in terms of the variables in the database. It will generate one box per group showing the number of rows of the group that matches the condition, and will retain only those rows in the data base. 3 | #' 4 | #' @param object fc object that we want to filter. 5 | #' @param filter Expression that returns a logical value and are defined in terms of the variables in the data frame. The data base will be filtered by this expression, and it will create a box showing the number of rows satisfying this condition. 6 | #' @param N Number of rows after the filter in case `filter` is NULL. 7 | #' @param label Character or expression that will be the title of the box. By default it will be the evaluated condition. 8 | #' @param text_pattern Character or expression defining the structure that will have the text in each of the boxes. It recognizes label, n, N and perc within brackets. For default it is "\{label\}\\n \{n\} (\{perc\}\%)". If text_pattern or label is an expression, the label is always placed at the beginning of the pattern, followed by a line break where the structure specified by text_pattern is placed. 9 | #' @param perc_total logical. Should percentages be calculated using the total number of rows at the beginning of the flowchart? Default is FALSE, meaning that they will be calculated using the number at the parent leaf. 10 | #' @param show_exc Logical value. If TRUE a box showing the number of excluded rows will be added to the flow chart. 11 | #' @param direction_exc One of "left" or "right" indicating if the exclusion box goes into the left direction or in the right direction. By default is "right". 12 | #' @param label_exc Character or expression that will be the title of the added box showing the excluded patients. By default it will show "Excluded". 13 | #' @param text_pattern_exc Character or expression defining the structure that will have the text in the exclude box. It recognizes label, n, N and perc within brackets. For default it is "\{label\}\\n \{n\} (\{perc\}\%)". If text_pattern or label is an expression, the label is always placed at the beginning of the pattern, followed by a line break where the structure specified by text_pattern_exc is placed. 14 | #' @param sel_group Select the group in which to perform the filter. The default is NULL. Can only be used if the flowchart has previously been split. If the flowchart has more than one group, it can either be given the full name as it is stored in the `$fc` component (separated by '\\'), or it can be given as a vector with the names of each group to be selected. 15 | #' @param round_digits Number of digits to round percentages. It is 2 by default. 16 | #' @param just Justification for the text: left, center or right. Default is center. 17 | #' @param text_color Color of the text. It is black by default. See the `col` parameter for \code{\link{gpar}}. 18 | #' @param text_fs Font size of the text. It is 8 by default. See the `fontsize` parameter for \code{\link{gpar}}. 19 | #' @param text_fface Font face of the text. It is 1 by default. See the `fontface` parameter for \code{\link{gpar}}. 20 | #' @param text_ffamily Changes the font family of the text. Default is NA. See the `fontfamily` parameter for \code{\link{gpar}}. 21 | #' @param text_padding Changes the text padding inside the box. Default is 1. This number has to be greater than 0. 22 | #' @param bg_fill Box background color. It is white by default. See the `fill` parameter for \code{\link{gpar}}. 23 | #' @param border_color Box border color. It is black by default. See the `col` parameter for \code{\link{gpar}}. 24 | #' @param width Width of the box. If NA, it automatically adjusts to the content (default). Must be an object of class \code{\link{unit}} or a number between 0 and 1. 25 | #' @param height Height of the box. If NA, it automatically adjusts to the content (default). Must be an object of class \code{\link{unit}} or a number between 0 and 1. 26 | #' @param just_exc Justification for the text of the exclude box: left, center or right. Default is center. 27 | #' @param text_color_exc Color of the text of the exclude box. It is black by default. See `text_color`. 28 | #' @param text_fs_exc Font size of the text of the exclude box. It is 6 by default. See `text_fs`. 29 | #' @param text_fface_exc Font face of the text of the exclude box. It is 1 by default. See the `fontface` parameter for \code{\link{gpar}}. See `text_fface`. 30 | #' @param text_ffamily_exc Changes the font family of the text of the exclude box. Default is NA. See the `fontfamily` parameter for \code{\link{gpar}}. See `text_ffamily`. 31 | #' @param text_padding_exc Changes the text padding inside the exclude box. Default is 1. This number has to be greater than 0. 32 | #' @param bg_fill_exc Exclude box background color. It is white by default. See `bg_fill`. 33 | #' @param border_color_exc Box background color of the exclude box. It is black by default. See `border_color`. 34 | #' @param offset_exc Amount of space to add to the distance between the box and the excluded box (in the x coordinate). If positive, this distance will be larger. If negative, it will be smaller. This number has to be at least between 0 and 1 (plot limits) and the resulting x coordinate cannot exceed these plot limits. The default is NULL (no offset). 35 | #' @param width_exc Width of the exclude box. If NA, it automatically adjusts to the content (default). Must be an object of class \code{\link{unit}} or a number between 0 and 1. 36 | #' @param height_exc Height of the box. If NA, it automatically adjusts to the content (default). Must be an object of class \code{\link{unit}} or a number between 0 and 1. 37 | #' @return List with the filtered dataset and the flowchart parameters with the resulting filtered box. 38 | #' 39 | #' @examples 40 | #' safo |> 41 | #' as_fc(label = "Patients assessed for eligibility") |> 42 | #' fc_filter(!is.na(group), label = "Randomized", show_exc = TRUE) |> 43 | #' fc_draw() 44 | #' 45 | #' @export 46 | 47 | fc_filter <- function(object, filter = NULL, N = NULL, label = NULL, text_pattern = "{label}\n {n} ({perc}%)", perc_total = FALSE, show_exc = FALSE, direction_exc = "right", label_exc = "Excluded", text_pattern_exc = "{label}\n {n} ({perc}%)", sel_group = NULL, round_digits = 2, just = "center", text_color = "black", text_fs = 8, text_fface = 1, text_ffamily = NA, text_padding = 1, bg_fill = "white", border_color = "black", width = NA, height = NA, just_exc = "center", text_color_exc = "black", text_fs_exc = 6, text_fface_exc = 1, text_ffamily_exc = NA, text_padding_exc = 1, bg_fill_exc = "white", border_color_exc = "black", offset_exc = NULL, width_exc = NA, height_exc = NA) { 48 | 49 | is_class(object, "fc") 50 | UseMethod("fc_filter") 51 | 52 | } 53 | 54 | #' @export 55 | #' @importFrom rlang .data 56 | #' @importFrom rlang := 57 | 58 | fc_filter.fc <- function(object, filter = NULL, N = NULL, label = NULL, text_pattern = "{label}\n {n} ({perc}%)", perc_total = FALSE, show_exc = FALSE, direction_exc = "right", label_exc = "Excluded", text_pattern_exc = "{label}\n {n} ({perc}%)", sel_group = NULL, round_digits = 2, just = "center", text_color = "black", text_fs = 8, text_fface = 1, text_ffamily = NA, text_padding = 1, bg_fill = "white", border_color = "black", width = NA, height = NA, just_exc = "center", text_color_exc = "black", text_fs_exc = 6, text_fface_exc = 1, text_ffamily_exc = NA, text_padding_exc = 1, bg_fill_exc = "white", border_color_exc = "black", offset_exc = NULL, width_exc = NA, height_exc = NA) { 59 | 60 | filter <- paste(deparse(substitute(filter)), collapse = "") 61 | filter <- gsub(" ", "", filter) 62 | 63 | if(filter == "NULL" & is.null(N)) { 64 | cli::cli_abort("Either {.arg filter} or {.arg N} arguments must be specified.") 65 | }else if(filter != "NULL" & !is.null(N)) { 66 | cli::cli_abort("The {.arg filter} and {.arg N} arguments cannot be specified simultaneously.") 67 | } 68 | 69 | if(!is.null(sel_group)) { 70 | 71 | if(!all(is.na(object$fc$group))) { 72 | 73 | if(length(sel_group) > 1) { 74 | sel_group <- paste(sel_group, collapse = " // ") 75 | } 76 | 77 | if(!any(sel_group %in% object$fc$group)) { 78 | cli::cli_abort( 79 | c( 80 | "The specified {.arg sel_group} does not match any group of the flowchart.", 81 | "i" = "Found groups in the flowchart: {object$fc$group[!is.na(object$fc$group)]}" 82 | ) 83 | ) 84 | } 85 | 86 | } else { 87 | 88 | cli::cli_abort("Cannot supply {.arg sel_group} because no groups exist in the flowchart yet, as no previous split has been performed.") 89 | 90 | } 91 | 92 | } 93 | 94 | if(filter == "NULL") { 95 | num <- length(grep("filter\\d+", names(object$data))) 96 | filter <- stringr::str_glue("filter{num + 1}") 97 | 98 | if(is.null(attr(object$data, "groups"))) { 99 | if(length(N) > 1) { 100 | cli::cli_abort("The length of {.arg N} has to be 1.") 101 | } 102 | } else { 103 | if(length(N) != nrow(attr(object$data, "groups"))) { 104 | if(is.null(sel_group)) { 105 | cli::cli_abort("The length of {.arg N} has to match the number of groups in the dataset: {nrow(attr(object$data, 'groups'))}") 106 | } else { 107 | if(length(N) != length(sel_group)) { 108 | cli::cli_abort("The length of {.arg N} has to match the number of selected groups in {.arg sel_group}") 109 | } 110 | } 111 | } 112 | } 113 | 114 | 115 | object$data$row_number_delete <- 1:nrow(object$data) 116 | #select rows to be true the filter 117 | tbl_groups <- attr(object$data, "groups") 118 | 119 | if(!is.null(tbl_groups)) { 120 | 121 | if(!is.null(sel_group)) { 122 | 123 | tbl_groups <- tbl_groups |> 124 | tidyr::unite("groups", -".rows", sep = " // ") 125 | 126 | if(sel_group %in% tbl_groups$groups) { 127 | 128 | tbl_groups <- tbl_groups |> 129 | dplyr::filter(groups == sel_group) 130 | 131 | } else { 132 | 133 | cli::cli_abort("The specified {.arg sel_group} is not a grouping variable of the data. It has to be one of: {tbl_groups$groups}") 134 | 135 | } 136 | 137 | } 138 | 139 | filt_rows <- unlist(purrr::map(1:nrow(tbl_groups), function (x) { 140 | if(N[x] > length(tbl_groups$.rows[[x]])) { 141 | cli::cli_abort("The number of rows after the filter specified in {.arg N} can't be greater than the original number of rows.") 142 | } else { 143 | tbl_groups$.rows[[x]][1:N[x]] 144 | } 145 | })) 146 | 147 | } else { 148 | 149 | nrows <- 1:nrow(object$data) 150 | 151 | if(N > length(nrows)) { 152 | cli::cli_abort("The number of rows after the filter specified in {.arg N} cannot exceed the original number of rows.") 153 | } 154 | 155 | filt_rows <- nrows[1:N] 156 | 157 | } 158 | 159 | 160 | 161 | object$data <- object$data |> 162 | dplyr::mutate( 163 | "{filter}" := dplyr::case_when( 164 | .data$row_number_delete %in% filt_rows ~ TRUE, 165 | TRUE ~ FALSE 166 | ) 167 | ) |> 168 | dplyr::select(-"row_number_delete") 169 | 170 | } 171 | 172 | if(is.null(label)) { 173 | label <- filter 174 | } 175 | 176 | group0 <- names(attr(object$data, "groups")) 177 | group0 <- group0[group0 != ".rows"] 178 | 179 | filter_to_parse <- filter 180 | new_fc <- object$data |> 181 | dplyr::summarise( 182 | n = sum(rlang::eval_tidy(rlang::parse_expr(filter_to_parse)), na.rm = TRUE), 183 | N = dplyr::n() 184 | ) 185 | 186 | if(is.null(group0)) { 187 | 188 | new_fc$group <- NA 189 | 190 | new_fc <- new_fc |> 191 | dplyr::left_join(object$fc |> dplyr::filter(.data$type != "exclude") |> dplyr::select("x", "group"), by = "group") |> 192 | dplyr::group_by(.data$group) |> 193 | dplyr::slice_tail(n = 1) |> 194 | dplyr::ungroup() 195 | 196 | } else { 197 | 198 | new_fc <- new_fc |> 199 | dplyr::mutate_at(tidyselect::all_of(group0), ~dplyr::case_when(is.na(.) ~ "NA", .default = .))|> 200 | tidyr::unite("group", c(tidyselect::all_of(group0)), sep = " // ", na.rm = TRUE) |> 201 | dplyr::left_join(object$fc |> dplyr::filter(.data$type != "exclude") |> dplyr::select("x", "group"), by = "group") |> 202 | dplyr::mutate(group = factor(.data$group, levels = unique(.data$group))) |> 203 | dplyr::group_by(.data$group) |> 204 | dplyr::slice_tail(n = 1) |> 205 | dplyr::ungroup() |> 206 | dplyr::mutate(group = as.character(.data$group)) 207 | 208 | } 209 | 210 | 211 | if(perc_total) { 212 | N_total <- unique( 213 | object$fc |> 214 | dplyr::filter(.data$y == max(.data$y)) |> 215 | dplyr::pull("N") 216 | ) 217 | new_fc <- new_fc |> 218 | dplyr::mutate( 219 | N_total = N_total 220 | ) 221 | } else { 222 | new_fc <- new_fc |> 223 | dplyr::mutate( 224 | N_total = .data$N 225 | ) 226 | } 227 | 228 | if(text_padding == 0 | text_padding_exc == 0) { 229 | cli::cli_abort("Text padding cannot be equal to zero.") 230 | } 231 | 232 | new_fc <- new_fc |> 233 | dplyr::mutate( 234 | y = NA, 235 | perc = round(.data$n*100/.data$N_total, round_digits), 236 | type = "filter", 237 | just = just, 238 | text_color = text_color, 239 | text_fs = text_fs, 240 | text_fface = text_fface, 241 | text_ffamily = text_ffamily, 242 | text_padding = text_padding, 243 | bg_fill = bg_fill, 244 | border_color = border_color, 245 | width = width, 246 | height = height 247 | ) |> 248 | dplyr::ungroup() |> 249 | dplyr::select(-N_total) 250 | 251 | if(is.expression(label) | is.expression(text_pattern)) { 252 | 253 | if(is.expression(text_pattern)) { 254 | 255 | text_pattern_exp <- gsub("\\{label\\}", "", as.character(text_pattern)) |> 256 | stringr::str_glue(.envir = rlang::as_environment(new_fc)) 257 | 258 | text_pattern_exp <- tryCatch( 259 | parse(text = text_pattern_exp), 260 | error = \(e) { 261 | list(as.character(text_pattern_exp)) 262 | }) 263 | 264 | new_fc <- new_fc |> 265 | dplyr::mutate(text = list(substitute(atop(x, y), list(x = label[[1]], y = text_pattern_exp[[1]])))) 266 | 267 | } else { 268 | 269 | text_pattern_exp <- gsub("\\{label\\}", "", text_pattern) 270 | 271 | new_fc <- new_fc |> 272 | dplyr::mutate(text = list(substitute(atop(x, y), list(x = label[[1]], y = stringr::str_glue(text_pattern_exp))))) 273 | 274 | } 275 | 276 | } else if(is.character(label) & is.character(text_pattern)) { 277 | 278 | new_fc <- new_fc |> 279 | dplyr::mutate(text = as.character(stringr::str_glue(text_pattern))) 280 | 281 | } else { 282 | 283 | cli::cli_abort("The {.arg label} and {.arg text_pattern} must be either characters or expressions.") 284 | 285 | } 286 | 287 | new_fc <- new_fc |> 288 | dplyr::relocate("text", .after = "perc") 289 | 290 | 291 | if(is.null(sel_group)) { 292 | 293 | new_fc <- new_fc |> 294 | dplyr::select("x", "y", "n", "N", "perc", "text", "type", "group", "just", "text_color", "text_fs", "text_fface", "text_ffamily", "text_padding", "bg_fill", "border_color", "width", "height") 295 | 296 | } else { 297 | 298 | new_fc <- new_fc |> 299 | dplyr::filter(.data$group %in% sel_group) |> 300 | dplyr::select("x", "y", "n", "N", "perc", "text", "type", "group", "just", "text_color", "text_fs", "text_fface", "text_ffamily", "text_padding", "bg_fill", "border_color", "width", "height") 301 | 302 | } 303 | 304 | 305 | #remove the id previous to adding the next one 306 | if(!is.null(object$fc)) { 307 | 308 | object$fc <- object$fc |> 309 | dplyr::select(-"id") |> 310 | dplyr::mutate(old = TRUE) 311 | 312 | #If we select a group, it only updates the box in the group so the other group remains being the end of the flowchart 313 | if(is.null(sel_group)) { 314 | 315 | object$fc <- object$fc |> 316 | dplyr::mutate(end = FALSE) 317 | 318 | } else { 319 | 320 | object$fc <- object$fc |> 321 | dplyr::mutate( 322 | end = dplyr::case_when( 323 | .data$group %in% sel_group ~ FALSE, 324 | .default = .data$end 325 | ) 326 | ) 327 | 328 | } 329 | 330 | 331 | } 332 | 333 | object$fc <- rbind( 334 | object$fc, 335 | new_fc |> 336 | dplyr::mutate(end = TRUE, 337 | old = FALSE) 338 | ) |> 339 | dplyr::mutate( 340 | y = update_y(.data$y, .data$type, .data$x, .data$group) 341 | ) 342 | 343 | #If we have to add the filter box 344 | if(show_exc) { 345 | 346 | add_x <- dplyr::case_when( 347 | direction_exc == "right" ~ 0.15, 348 | direction_exc == "left" ~ -0.15, 349 | TRUE ~ NA 350 | ) 351 | #For the box to not escape the margins: 352 | x_margin <- new_fc |> 353 | dplyr::mutate( 354 | limit = dplyr::case_when( 355 | .data$x + add_x <= 0.05 ~ -.data$x/2, 356 | .data$x + add_x >= 0.95 ~ (1 - .data$x)/2, 357 | TRUE ~ NA 358 | ) 359 | ) |> 360 | dplyr::filter(!is.na(.data$limit)) 361 | 362 | if(nrow(x_margin) > 0) { 363 | min_add <- min(abs(x_margin$limit)) 364 | add_x <- dplyr::case_when( 365 | sign(add_x) != sign(min_add) ~ min_add*(-1), 366 | TRUE ~ min_add 367 | ) 368 | } 369 | 370 | if(!is.null(offset_exc)) { 371 | add_x <- add_x + offset_exc 372 | } 373 | 374 | #Calculate the middle distance between the box and the parent 375 | new_fc <- object$fc |> 376 | dplyr::filter(!.data$old) 377 | 378 | #The label in the text_pattern references to label_exc and not to label 379 | label <- label_exc 380 | 381 | new_fc2 <- new_fc |> 382 | dplyr::mutate( 383 | parent = purrr::map(.data$x, ~object$fc |> 384 | dplyr::filter(.data$x == .x, .data$old) |> 385 | dplyr::last() |> 386 | dplyr::select("y", "n") 387 | ), 388 | x = .data$x + add_x, 389 | y = purrr::map2_dbl(.data$parent, .data$y, ~(.y + .x$y)/2), 390 | n = purrr::map2_int(.data$parent, .data$n, ~.x$n - .y), 391 | N = purrr::map_int(.data$parent, ~.x$n) 392 | ) 393 | 394 | if(!is.null(offset_exc)) { 395 | if(!all(new_fc2$x >= 0 & new_fc2$x <= 1)) { 396 | cli::cli_abort( 397 | c( 398 | "The x-coordinate cannot exceed the plot limits 0 and 1.", 399 | "i" = "The argument {.arg offset_exc} has to be set to a smaller number." 400 | ) 401 | ) 402 | } 403 | } 404 | 405 | if(perc_total) { 406 | N_total <- unique( 407 | object$fc |> 408 | dplyr::filter(.data$y == max(.data$y)) |> 409 | dplyr::pull("N") 410 | ) 411 | new_fc2 <- new_fc2 |> 412 | dplyr::mutate( 413 | N_total = N_total 414 | ) 415 | } else { 416 | new_fc2 <- new_fc2 |> 417 | dplyr::mutate( 418 | N_total = .data$N 419 | ) 420 | } 421 | 422 | 423 | new_fc2 <- new_fc2 |> 424 | dplyr::mutate( 425 | perc = purrr::map2_dbl(.data$n, .data$N_total, ~round(.x*100/.y, round_digits)), 426 | type = "exclude", 427 | just = just_exc, 428 | text_color = text_color_exc, 429 | text_fs = text_fs_exc, 430 | text_fface = text_fface_exc, 431 | text_ffamily = text_ffamily_exc, 432 | text_padding = text_padding_exc, 433 | bg_fill = bg_fill_exc, 434 | border_color = border_color_exc, 435 | width = width_exc, 436 | height = height_exc 437 | ) |> 438 | dplyr::select(-"parent", -"N_total") 439 | 440 | if(is.expression(label_exc) | is.expression(text_pattern_exc)) { 441 | 442 | if(is.expression(text_pattern_exc)) { 443 | 444 | text_pattern_exc_exp <- gsub("\\{label\\}", "", as.character(text_pattern_exc)) |> 445 | stringr::str_glue(.envir = rlang::as_environment(new_fc2)) 446 | 447 | text_pattern_exc_exp <- tryCatch( 448 | parse(text = text_pattern_exc_exp), 449 | error = \(e) { 450 | list(as.character(text_pattern_exc_exp)) 451 | }) 452 | 453 | new_fc2 <- new_fc2 |> 454 | dplyr::mutate(text = list(substitute(atop(x, y), list(x = label_exc[[1]], y = text_pattern_exc_exp[[1]])))) 455 | 456 | } else { 457 | 458 | text_pattern_exc_exp <- gsub("\\{label\\}", "", text_pattern_exc) 459 | 460 | new_fc2 <- new_fc2 |> 461 | dplyr::mutate(text = list(substitute(atop(x, y), list(x = label_exc[[1]], y = stringr::str_glue(text_pattern_exc_exp))))) 462 | 463 | } 464 | 465 | } else if(is.character(label_exc) & is.character(text_pattern_exc)) { 466 | 467 | new_fc2 <- new_fc2 |> 468 | dplyr::mutate(text = as.character(stringr::str_glue(text_pattern_exc))) 469 | 470 | } else { 471 | 472 | cli::cli_abort("The {.arg label_exc} and {.arg text_pattern_exc} must be either characters or expressions.") 473 | 474 | } 475 | 476 | new_fc2 <- new_fc2 |> 477 | dplyr::relocate("text", .after = "perc") 478 | 479 | new_fc3 <- NULL 480 | for(i in 1:nrow(new_fc2)) { 481 | new_fc3 <- rbind(new_fc3, new_fc[i,], new_fc2[i,]) 482 | } 483 | 484 | object$fc <- rbind( 485 | object$fc |> dplyr::filter(.data$old), 486 | new_fc3 |> 487 | tibble::as_tibble() |> 488 | dplyr::mutate( 489 | end = FALSE, 490 | .before = "old" 491 | ) 492 | ) 493 | 494 | } 495 | 496 | object$fc <- object$fc |> 497 | dplyr::select(-"old") |> 498 | dplyr::mutate( 499 | id = dplyr::row_number() 500 | ) |> 501 | dplyr::relocate("id") 502 | 503 | 504 | #Filter the database 505 | if(is.null(sel_group)) { 506 | 507 | object$data <- object$data |> 508 | dplyr::filter(rlang::eval_tidy(rlang::parse_expr(filter_to_parse))) 509 | 510 | } else { 511 | 512 | groups <- names(attr(object$data, "groups")) 513 | groups <- groups[groups != ".rows"] 514 | 515 | filter_to_parse <- stringr::str_glue("{filter_to_parse} | temp_var_PauSatorra_12345 != '{sel_group}'") 516 | object$data <- object$data |> 517 | tidyr::unite("temp_var_PauSatorra_12345", c(tidyselect::all_of(groups)), sep = " // ", na.rm = TRUE, remove = FALSE) |> 518 | dplyr::filter(rlang::eval_tidy(rlang::parse_expr(filter_to_parse))) |> 519 | dplyr::select(-"temp_var_PauSatorra_12345") 520 | } 521 | 522 | object 523 | 524 | 525 | } 526 | -------------------------------------------------------------------------------- /R/fc_merge.R: -------------------------------------------------------------------------------- 1 | #' @title fc_merge 2 | #' @description This function allows to combine horizontally two different flowcharts. 3 | #' 4 | #' @param fcs list with all the flowcharts that we want to merge 5 | #' @return List containing a list with the datasets belonging to each flowchart and another list with each of the flowcharts parameters to merge. 6 | #' 7 | #' @examples 8 | #' # Create first flowchart for ITT 9 | #' fc1 <- safo |> 10 | #' as_fc(label = "Patients assessed for eligibility") |> 11 | #' fc_filter(itt == "Yes", label = "Intention to treat (ITT)") 12 | #' 13 | #' 14 | #' # Create second flowchart for PP 15 | #' fc2 <- safo |> 16 | #' as_fc(label = "Patients assessed for eligibility") |> 17 | #' fc_filter(pp == "Yes", label = "Per protocol (PP)") 18 | #' 19 | #' list(fc1, fc2) |> 20 | #' fc_merge() |> 21 | #' fc_draw() 22 | #' 23 | #' @export 24 | #' @importFrom rlang .data 25 | 26 | fc_merge <- function(fcs) { 27 | 28 | purrr::map(fcs, ~is_class(.x, "fc")) 29 | 30 | object <- tibble::tibble( 31 | id = 1:length(fcs), 32 | data = purrr::map(fcs, ~.x$data), 33 | fc = purrr::map(fcs, ~.x$fc) 34 | ) |> 35 | dplyr::mutate( 36 | fc = purrr::map(seq_along(.data$fc), function(i) { 37 | .data$fc[[i]] |> 38 | dplyr::mutate( 39 | x = update_x(.data$x, i, length(fcs)) 40 | ) 41 | 42 | 43 | }) 44 | ) 45 | 46 | class(object) <- "fc" 47 | 48 | object 49 | 50 | } 51 | -------------------------------------------------------------------------------- /R/fc_modify.R: -------------------------------------------------------------------------------- 1 | #' @title fc_modify 2 | #' @description This function allows to modify the `.$fc` tibble included in each fc object that contains all the parameters of the flowchart. 3 | #' 4 | #' @param object flowchart created as a fc object. 5 | #' @param fun A function or formula that will be applied to `.$fc`. If a _function_, it is used as is. If a _formula_, e.g. `fun = ~.x |> mutate(x = x + 0.2)`, it is converted to a function. 6 | #' @param ... Additional arguments passed on to the mapped function. 7 | #' @return List with the dataset and the modified flowchart parameters. 8 | #' 9 | #' @examples 10 | #' #Example: let's modify the excluded box 11 | #' text_exc <- paste0( 12 | #' sum(safo$inclusion_crit == "Yes"), 13 | #' " not met the inclusion criteria\n", 14 | #' sum(safo$exclusion_crit == "Yes"), 15 | #' " met the exclusion criteria" 16 | #' ) 17 | #' 18 | #' safo |> 19 | #' as_fc(label = "Patients assessed for eligibility") |> 20 | #' fc_filter(!is.na(group), label = "Randomized", show_exc = TRUE) |> 21 | #' fc_modify( 22 | #' ~ . |> 23 | #' dplyr::mutate( 24 | #' text = ifelse(id == 3, text_exc, text), 25 | #' x = ifelse(id == 3, 0.75, x) 26 | #' ) 27 | #' ) |> 28 | #' fc_draw() 29 | #' 30 | #' @export 31 | 32 | fc_modify <- function(object, fun, ...) { 33 | 34 | is_class(object, "fc") 35 | UseMethod("fc_modify") 36 | 37 | } 38 | 39 | #' @export 40 | 41 | fc_modify.fc <- function(object, fun, ...) { 42 | 43 | #Execute function on .$fc 44 | 45 | if(tibble::is_tibble(object$fc)) { 46 | 47 | object$fc <- list(object$fc) 48 | object$fc <- purrr::map_dfr(object$fc, fun, ...) 49 | 50 | } else { 51 | 52 | object$fc <- purrr::map(object$fc, fun, ...) 53 | 54 | } 55 | 56 | object 57 | 58 | } 59 | -------------------------------------------------------------------------------- /R/fc_split.R: -------------------------------------------------------------------------------- 1 | #' @title fc_split 2 | #' @description This function allows to split the flowchart in function of the categories of a column of the database. It will generate as many boxes as categories has the column showing in each one the frequency of each category. It will additionally group the database per this column. 3 | #' 4 | #' @param object fc object that we want to split. 5 | #' @param var variable column of the database from which it will be splitted. 6 | #' @param N Number of rows after the split in case `var` is NULL. 7 | #' @param label Vector of characters or vector of expressions with the label of each category in order. It has to have as many elements as categories has the column. By default, it will put the labels of the categories. 8 | #' @param text_pattern Character or expression defining the structure that will have the text in each of the boxes. It recognizes label, n, N and perc within brackets. For default it is "\{label\}\\n \{n\} (\{perc\}\%)". If text_pattern or label is an expression, the label is always placed at the beginning of the pattern, followed by a line break where the structure specified by text_pattern is placed. 9 | #' @param perc_total logical. Should percentages be calculated using the total number of rows at the beginning of the flowchart? Default is FALSE, meaning that they will be calculated using the number at the parent leaf. 10 | #' @param sel_group Select the group in which to perform the filter. The default is NULL. Can only be used if the flowchart has previously been split. If the flowchart has more than one group, it can either be given the full name as it is stored in the `$fc` component (separated by '\\'), or it can be given as a vector with the names of each group to be selected. 11 | #' @param na.rm logical. Should missing values of the grouping variable be removed? Default is FALSE. 12 | #' @param show_zero logical. Should the levels of the grouping variable that don't have data be shown? Default is FALSE. 13 | #' @param round_digits Number of digits to round percentages. It is 2 by default. 14 | #' @param just Justification for the text: left, center or right. Default is center. 15 | #' @param text_color Color of the text. It is black by default. 16 | #' @param text_fs Font size of the text. It is 8 by default. 17 | #' @param text_fface Font face of the text. It is 1 by default. See the `fontface` parameter for \code{\link{gpar}}. 18 | #' @param text_ffamily Changes the font family of the text. Default is NA. See the `fontfamily` parameter for \code{\link{gpar}}. 19 | #' @param text_padding Changes the text padding inside the box. Default is 1. This number has to be greater than 0. 20 | #' @param bg_fill Box background color. It is white by default. 21 | #' @param border_color Box border color. It is black by default. 22 | #' @param width Width of the box. If NA, it automatically adjusts to the content (default). Must be an object of class \code{\link{unit}} or a number between 0 and 1. 23 | #' @param height Height of the box. If NA, it automatically adjusts to the content (default). Must be an object of class \code{\link{unit}} or a number between 0 and 1. 24 | #' @param title Add a title box to the split. Default is NULL. It can only be used when there are only two resulting boxes after the split. 25 | #' @param text_color_title Color of the title text. It is black by default. 26 | #' @param text_fs_title Font size of the title text. It is 8 by default. 27 | #' @param text_fface_title Font face of the title text. It is 1 by default. See the `fontface` parameter for \code{\link{gpar}}. 28 | #' @param text_ffamily_title Changes the font family of the title text. Default is NA. See the `fontfamily` parameter for \code{\link{gpar}}. 29 | #' @param text_padding_title Changes the title text padding inside the box. Default is 1. This number has to be greater than 0. 30 | #' @param bg_fill_title Title box background color. It is white by default. 31 | #' @param border_color_title Title box border color. It is black by default. 32 | #' @param width_title Width of the title box. If NA, it automatically adjusts to the content (default). Must be an object of class \code{\link{unit}} or a number between 0 and 1. 33 | #' @param height_title Height of the title box. If NA, it automatically adjusts to the content (default). Must be an object of class \code{\link{unit}} or a number between 0 and 1. 34 | #' @param offset Amount of space to add to the distance between boxes (in the x coordinate). If positive, this distance will be larger. If negative, it will be smaller. This number has to be at least between 0 and 1 (plot limits) and the resulting x coordinate cannot exceed these plot limits. The default is NULL (no offset). 35 | #' @return List with the dataset grouped by the splitting variable and the flowchart parameters with the resulting split. 36 | #' 37 | #' @examples 38 | #' safo |> 39 | #' dplyr::filter(!is.na(group)) |> 40 | #' as_fc(label = "Randomized patients") |> 41 | #' fc_split(group) |> 42 | #' fc_draw() 43 | #' 44 | #' @export 45 | 46 | fc_split <- function(object, var = NULL, N = NULL, label = NULL, text_pattern = "{label}\n {n} ({perc}%)", perc_total = FALSE, sel_group = NULL, na.rm = FALSE, show_zero = FALSE, round_digits = 2, just = "center", text_color = "black", text_fs = 8, text_fface = 1, text_ffamily = NA, text_padding = 1, bg_fill = "white", border_color = "black", width = NA, height = NA, title = NULL, text_color_title = "black", text_fs_title = 10, text_fface_title = 1, text_ffamily_title = NA, text_padding_title = 0.6, bg_fill_title = "white", border_color_title = "black", width_title = NA, height_title = NA, offset = NULL) { 47 | 48 | is_class(object, "fc") 49 | UseMethod("fc_split") 50 | 51 | } 52 | 53 | 54 | #' @export 55 | #' @importFrom rlang .data 56 | 57 | fc_split.fc <- function(object, var = NULL, N = NULL, label = NULL, text_pattern = "{label}\n {n} ({perc}%)", perc_total = FALSE, sel_group = NULL, na.rm = FALSE, show_zero = FALSE, round_digits = 2, just = "center", text_color = "black", text_fs = 8, text_fface = 1, text_ffamily = NA, text_padding = 1, bg_fill = "white", border_color = "black", width = NA, height = NA, title = NULL, text_color_title = "black", text_fs_title = 10, text_fface_title = 1, text_ffamily_title = NA, text_padding_title = 0.6, bg_fill_title = "white", border_color_title = "black", width_title = NA, height_title = NA, offset = NULL) { 58 | 59 | var <- substitute(var) 60 | 61 | if(!is.character(var)) { 62 | var <- deparse(var) 63 | } 64 | 65 | if(var == "NULL" & is.null(N)) { 66 | cli::cli_abort("A {.arg var} or {.arg N} argument must be specified.") 67 | }else if(var != "NULL" & !is.null(N)) { 68 | cli::cli_abort("Arguments {.arg var} and {.arg N} cannot be specified simultaneously.") 69 | } 70 | 71 | if(!is.null(sel_group)) { 72 | 73 | if(!all(is.na(object$fc$group))) { 74 | 75 | if(length(sel_group) > 1) { 76 | sel_group <- paste(sel_group, collapse = " // ") 77 | } 78 | 79 | if(!any(sel_group %in% object$fc$group)) { 80 | cli::cli_abort( 81 | c( 82 | "The specified {.arg sel_group} does not match any group of the flowchart.", 83 | "i" = "Found groups in the flowchart are:\n{object$fc$group[!is.na(object$fc$group)]}" 84 | ) 85 | ) 86 | } 87 | 88 | } else { 89 | 90 | cli::cli_abort("The {.arg sel_group} argument can't be used because no groups exist in the flowchart, as no previous split has been performed.") 91 | 92 | } 93 | 94 | } 95 | 96 | if(var == "NULL") { 97 | num <- length(grep("split\\d+", names(object$data))) 98 | var <- stringr::str_glue("split{num + 1}") 99 | 100 | if(!is.null(attr(object$data, "groups"))) { 101 | 102 | if(!is.null(sel_group)) { 103 | 104 | tbl_groups <- attr(object$data, "groups") |> 105 | tidyr::unite("groups", -".rows", sep = " // ") |> 106 | dplyr::filter(.data$groups == sel_group) 107 | 108 | nrows <- tbl_groups$.rows 109 | ngroups <- sel_group 110 | 111 | } else { 112 | 113 | nrows <- dplyr::group_rows(object$data) 114 | names(nrows) <- object$data |> 115 | attr("groups") |> 116 | dplyr::pull(1) 117 | 118 | ngroups <- names(nrows) 119 | 120 | } 121 | 122 | if(length(N) %% length(ngroups) != 0) { 123 | 124 | cli::cli_abort("The length of {.arg N} has to be a multiple to the number of groups in the dataset: {nrow(attr(object$data, 'groups'))}") 125 | 126 | } 127 | 128 | nsplit <- length(N)/length(ngroups) 129 | message_group <- " in each group." 130 | 131 | } else { 132 | 133 | nrows <- list(1:nrow(object$data)) 134 | ngroups <- 1 135 | nsplit <- length(N) 136 | message_group <- "." 137 | 138 | } 139 | 140 | object$data$row_number_delete <- 1:nrow(object$data) 141 | 142 | #select rows to be true the filter 143 | N_list <- split(N, rep(1:length(ngroups), rep(nsplit, length(ngroups)))) 144 | 145 | split_rows <- purrr::map_df(seq_along(N_list), function (x) { 146 | 147 | if(sum(N_list[[x]]) != length(nrows[[x]])) { 148 | cli::cli_abort("The number of rows after the split specified in N has to be equal to the original number of rows{message_group}") 149 | } 150 | 151 | tibble::tibble(group = paste("group", 1:nsplit)) |> 152 | dplyr::mutate( 153 | rows = split(nrows[[x]], rep(1:nsplit, N_list[[x]])) 154 | ) 155 | 156 | }) 157 | 158 | object$data[[var]] <- NA 159 | 160 | for(i in 1:nrow(split_rows)) { 161 | object$data[[var]] <- dplyr::case_when( 162 | object$data$row_number_delete %in% split_rows$rows[[i]] ~ split_rows$group[[i]], 163 | TRUE ~ object$data[[var]] 164 | ) 165 | } 166 | 167 | object$data <- object$data |> 168 | dplyr::select(-"row_number_delete") 169 | 170 | } 171 | 172 | if(na.rm) { 173 | object$data <- object$data |> 174 | dplyr::filter_at(var, ~!is.na(.x)) 175 | } 176 | 177 | if(!inherits(object$data[[var]], "factor")) { 178 | object$data <- object$data |> 179 | dplyr::mutate_at(var, as.factor) 180 | } 181 | 182 | new_fc <- object$data |> 183 | dplyr::count(label = get(var), .drop = FALSE) |> 184 | #To save the original label previous to changing it (in case that label is specified) 185 | dplyr::mutate(label0 = .data$label) 186 | 187 | #If we don't want to show the levels without an event: 188 | if(!show_zero) { 189 | new_fc <- new_fc |> 190 | dplyr::filter(.data$n != 0) 191 | } 192 | 193 | #In case the label is specified, change it in the text 194 | if(!is.null(label)) { 195 | new_fc$label <- factor(new_fc$label, levels = unique(new_fc$label), labels = label) 196 | } 197 | 198 | if(!is.null(attr(object$data, "groups"))) { 199 | 200 | Ndata <- object$data |> 201 | dplyr::count(name = "N") 202 | 203 | group0 <- names(attr(object$data, "groups")) 204 | group0 <- group0[group0 != ".rows"] 205 | 206 | new_fc <- new_fc |> 207 | dplyr::left_join(Ndata, by = group0) 208 | 209 | } else { 210 | 211 | new_fc <- new_fc |> 212 | dplyr::mutate( 213 | N = nrow(object$data) 214 | ) 215 | 216 | group0 <- NULL 217 | 218 | } 219 | 220 | if(perc_total) { 221 | N_total <- unique( 222 | object$fc |> 223 | dplyr::filter(.data$y == max(.data$y)) |> 224 | dplyr::pull("N") 225 | ) 226 | new_fc <- new_fc |> 227 | dplyr::mutate( 228 | N_total = N_total 229 | ) 230 | } else { 231 | new_fc <- new_fc |> 232 | dplyr::mutate( 233 | N_total = .data$N 234 | ) 235 | } 236 | 237 | if(any(text_padding == 0)) { 238 | cli::cli_abort("Text padding cannot be equal to zero.") 239 | } 240 | 241 | new_fc <- new_fc |> 242 | dplyr::mutate( 243 | x = NA, 244 | y = NA, 245 | perc = round(.data$n*100/.data$N_total, round_digits), 246 | type = "split", 247 | just = just, 248 | text_color = text_color, 249 | text_fs = text_fs, 250 | text_fface = text_fface, 251 | text_ffamily = text_ffamily, 252 | text_padding = text_padding, 253 | bg_fill = bg_fill, 254 | border_color = border_color, 255 | width = width, 256 | height = height 257 | ) |> 258 | dplyr::select(-N_total) 259 | 260 | if(is.null(label)) { 261 | label <- levels(new_fc$label) 262 | } 263 | 264 | if(is.expression(label) | is.expression(text_pattern)) { 265 | 266 | if(is.expression(text_pattern)) { 267 | 268 | text_pattern_exp <- gsub("\\{label\\}", "", as.character(text_pattern)) |> 269 | stringr::str_glue(.envir = rlang::as_environment(new_fc)) 270 | 271 | text_pattern_exp <- tryCatch( 272 | parse(text = text_pattern_exp), 273 | error = \(e) { 274 | list(as.character(text_pattern_exp)) 275 | }) 276 | 277 | #We have to consider the label in the environment not in the data 278 | new_fc <- new_fc |> 279 | dplyr::mutate(text = purrr::map(dplyr::row_number(), ~substitute(atop(x, y), list(x = .env$label[[.]], y = text_pattern_exp[[.]])))) 280 | 281 | } else { 282 | 283 | text_pattern_exp <- gsub("\\{label\\}", "", text_pattern) 284 | 285 | #We have to consider the label in the environment not in the data 286 | new_fc <- new_fc |> 287 | dplyr::mutate(text = purrr::map(dplyr::row_number(), ~substitute(atop(x, y), list(x = .env$label[[.]], y = stringr::str_glue(text_pattern_exp)[[.]])))) 288 | 289 | } 290 | 291 | } else if(is.character(label) & is.character(text_pattern)) { 292 | 293 | new_fc <- new_fc |> 294 | dplyr::mutate(text = as.character(stringr::str_glue(text_pattern))) 295 | 296 | } else { 297 | 298 | cli::cli_abort("The {.arg label} and {.arg text_pattern} must be either characters or expressions.") 299 | 300 | } 301 | 302 | 303 | new_fc <- new_fc |> 304 | dplyr::relocate("text", .after = "perc") 305 | 306 | if(is.null(sel_group)) { 307 | object$data <- object$data |> 308 | dplyr::group_by_at(c(group0, var), .drop = FALSE) 309 | } 310 | 311 | # x coordinate for the created boxes. 312 | #if there are no groups: 313 | if(is.null(group0)) { 314 | 315 | xval <- purrr::map_dbl(0:(nrow(new_fc) - 1), ~ (1 + 2*.x)/(2*nrow(new_fc))) 316 | 317 | #Offset distance between boxes: 318 | if(!is.null(offset)) { 319 | xval <- dplyr::case_when( 320 | xval > 0.5 ~ xval + offset, 321 | xval < 0.5 ~ xval - offset, 322 | .default = xval 323 | ) 324 | 325 | if(!all(xval >= 0 & xval <= 1)) { 326 | cli::cli_abort(c( 327 | "The x-coordinate cannot exceed the plot limits 0 and 1.", 328 | "i" = "The argument {.arg offset} has to be set to a smaller number." 329 | )) 330 | } 331 | 332 | } 333 | 334 | new_fc$x <- xval 335 | new_fc$group <- NA 336 | object_center <- new_fc |> 337 | dplyr::select("group") |> 338 | dplyr::mutate(center = 0.5) 339 | 340 | } else { 341 | 342 | new_fc <- new_fc |> 343 | tidyr::unite("group", c(tidyselect::all_of(group0)), sep = " // ") 344 | 345 | #Filter boxes in some groups if sel_group is specified 346 | if(!is.null(sel_group)) { 347 | 348 | if(any(new_fc$group %in% sel_group)) { 349 | 350 | new_fc <- new_fc |> 351 | dplyr::filter(.data$group %in% sel_group) 352 | 353 | } else { 354 | 355 | cli::cli_abort("The specified {.arg sel_group} is not a grouping variable of the data. It must be one of: {new_fc$group[!is.na(new_fc$group)]}") 356 | 357 | } 358 | 359 | } 360 | 361 | object_center <- object$fc |> 362 | dplyr::filter(.data$type != "exclude") |> 363 | dplyr::group_by(.data$group) |> 364 | dplyr::summarise( 365 | center = unique(.data$x) 366 | ) 367 | 368 | xval <- tibble::tibble(group = unique(new_fc$group)) |> 369 | dplyr::mutate( 370 | label = purrr::map(.data$group, ~new_fc |> 371 | dplyr::filter(.data$group == .) |> 372 | dplyr::distinct(.data$label) 373 | ), 374 | nboxes = purrr::map_dbl(.data$label, nrow) 375 | ) |> 376 | dplyr::full_join( 377 | object_center, by = "group" 378 | ) |> 379 | dplyr::arrange(.data$center) |> 380 | dplyr::filter(!is.na(.data$group)) |> 381 | dplyr::mutate( 382 | margins = purrr::pmap(list(.data$center, dplyr::lag(.data$center), dplyr::lead(.data$center)), function (x, xlag, xlead) { 383 | if(is.na(xlag)) { 384 | c(0, (x + xlead)/2) 385 | }else if(is.na(xlead)) { 386 | c((xlag + x)/2, 1) 387 | } else { 388 | c((xlag + x)/2, (x + xlead)/2) 389 | } 390 | }) 391 | ) |> 392 | dplyr::filter(!is.na(.data$nboxes)) |> 393 | dplyr::mutate( 394 | x = purrr::pmap(list(.data$center, .data$margins, .data$nboxes), function (xcenter, xmarg, xn) { 395 | 396 | min_marg <- min(xcenter - xmarg[1], xmarg[2] - xcenter) 397 | 398 | cuts <- purrr::map_dbl(0:(xn - 1), ~ (1 + 2*.x)/(2*xn)) 399 | 400 | (xcenter - min_marg) + cuts*2*min_marg 401 | # x <- seq(xcenter - min_marg, xcenter + min_marg, by = 2*min_marg/(xn + 1)) 402 | # x[!x %in% c(xcenter - min_marg, xcenter + min_marg)] 403 | 404 | }) 405 | ) |> 406 | tidyr::unnest(c("label", "x")) 407 | 408 | 409 | if(!is.null(offset)) { 410 | 411 | xval <- xval |> 412 | dplyr::mutate( 413 | x = dplyr::case_when( 414 | .data$x > center ~ .data$x + offset, 415 | .data$x < center ~ .data$x - offset, 416 | .default = .data$x 417 | ) 418 | ) 419 | 420 | } 421 | 422 | xval <- xval |> 423 | dplyr::select("group", "label", "x") 424 | 425 | #Juntar new_fc amb xval 426 | 427 | new_fc <- new_fc |> 428 | dplyr::select(-"x") |> 429 | dplyr::left_join(xval, by = c("group", "label")) |> 430 | dplyr::relocate("x", .before = "y") 431 | 432 | } 433 | 434 | group_old <- new_fc$group 435 | 436 | new_fc <- new_fc |> 437 | dplyr::mutate(label0 = dplyr::case_when( 438 | is.na(label0) ~ "NA", 439 | TRUE ~ label0 440 | )) |> 441 | tidyr::unite("group", c("group", "label0"), sep = " // ", na.rm = TRUE) |> 442 | dplyr::ungroup() |> 443 | dplyr::select("x", "y", "n", "N", "perc", "text", "type", "group", "just", "text_color", "text_fs", "text_fface", "text_ffamily", "text_padding", "bg_fill", "border_color", "width", "height") 444 | 445 | #remove the id previous to adding the next one 446 | if(!is.null(object$fc)) { 447 | object$fc <- object$fc |> 448 | dplyr::select(-"id") |> 449 | dplyr::mutate(old = TRUE) 450 | 451 | #If we select a group, it only updates the box in the group so the other group remains being the end of the flowchart 452 | if(is.null(sel_group)) { 453 | 454 | object$fc <- object$fc |> 455 | dplyr::mutate(end = FALSE) 456 | 457 | } else { 458 | 459 | object$fc <- object$fc |> 460 | dplyr::mutate( 461 | end = dplyr::case_when( 462 | .data$group %in% sel_group ~ FALSE, 463 | .default = .data$end 464 | ) 465 | ) 466 | 467 | } 468 | 469 | } 470 | 471 | object$fc <- rbind( 472 | object$fc, 473 | new_fc |> 474 | tibble::as_tibble() |> 475 | dplyr::mutate(end = TRUE, 476 | old = FALSE) 477 | ) |> 478 | dplyr::mutate( 479 | y = update_y(.data$y, .data$type, .data$x, .data$group), 480 | id = dplyr::row_number() 481 | ) |> 482 | dplyr::relocate("id") 483 | 484 | #If we have to add a title 485 | if(!is.null(title)) { 486 | new_fc2 <- object$fc |> 487 | dplyr::filter(!.data$old) |> 488 | dplyr::mutate(group = group_old) |> 489 | dplyr::group_by(.data$group) |> 490 | dplyr::summarise(n_boxes = dplyr::n(), 491 | y = unique(.data$y)) 492 | 493 | if(any(new_fc2$n_boxes == 2)) { 494 | 495 | new_fc2 <- new_fc2 |> 496 | dplyr::filter(.data$n_boxes == 2) |> 497 | dplyr::left_join(object_center, by = "group") |> 498 | dplyr::first() |> 499 | dplyr::mutate( 500 | id = NA, 501 | x = .data$center, 502 | n = NA, 503 | N = NA, 504 | n = NA, 505 | N = NA, 506 | perc = NA, 507 | text = title, 508 | type = "title_split", 509 | just = "center", 510 | text_color = text_color_title, 511 | text_fs = text_fs_title, 512 | text_fface = text_fface_title, 513 | text_ffamily = text_ffamily_title, 514 | text_padding = text_padding_title, 515 | bg_fill = bg_fill_title, 516 | border_color = border_color_title, 517 | width = width_title, 518 | height = height_title 519 | ) |> 520 | dplyr::select(-"center", -"n_boxes") |> 521 | dplyr::relocate("y", .after = "x") |> 522 | dplyr::relocate("group", .after = "type") 523 | 524 | } else { 525 | 526 | cli::cli_abort("The {.arg title} argument can only be used with exactly two resulting boxes after the split.") 527 | 528 | } 529 | 530 | 531 | object$fc <- rbind( 532 | object$fc, 533 | new_fc2 |> 534 | tibble::as_tibble() |> 535 | dplyr::mutate(end = FALSE, 536 | old = FALSE) 537 | ) |> 538 | dplyr::mutate(id = dplyr::row_number()) |> 539 | dplyr::relocate("id") 540 | 541 | } 542 | 543 | 544 | object$fc <- object$fc |> 545 | dplyr::select(-"old") 546 | 547 | object 548 | 549 | } 550 | -------------------------------------------------------------------------------- /R/fc_stack.R: -------------------------------------------------------------------------------- 1 | #' @title fc_stack 2 | #' @description This function allows to combine vertically two different flowcharts. 3 | #' 4 | #' @param fcs list with all the flowcharts that we want to merge 5 | #' @param unite logical value if the boxes have to be united or not. Default is FALSE. 6 | #' @return List containing a list with the datasets belonging to each flowchart and the flowchart parameters combining all the flowcharts. 7 | #' 8 | #' @examples 9 | #' # Create first flowchart for ITT 10 | #' fc1 <- safo |> 11 | #' as_fc(label = "Patients assessed for eligibility") |> 12 | #' fc_filter(itt == "Yes", label = "Intention to treat (ITT)") 13 | #' 14 | #' 15 | #' # Create second flowchart for PP 16 | #' fc2 <- safo |> 17 | #' as_fc(label = "Patients assessed for eligibility") |> 18 | #' fc_filter(pp == "Yes", label = "Per protocol (PP)") 19 | #' 20 | #' list(fc1, fc2) |> 21 | #' fc_stack() |> 22 | #' fc_draw() 23 | #' 24 | #' @export 25 | #' @importFrom rlang .data 26 | 27 | fc_stack <- function(fcs, unite = FALSE) { 28 | 29 | purrr::map(fcs, ~is_class(.x, "fc")) 30 | 31 | object <- tibble::tibble( 32 | id = 1:length(fcs), 33 | data = purrr::map(fcs, ~.x$data), 34 | fc = purrr::map(fcs, ~.x$fc) 35 | ) 36 | 37 | object <- object |> 38 | dplyr::mutate( 39 | fc = purrr::map(seq_along(.data$fc), function(i) { 40 | .data$fc[[i]] |> 41 | dplyr::mutate( 42 | y = update_y_stack(.data$y, .data$x, .data$type, i, length(fcs)) 43 | ) 44 | }) 45 | ) 46 | 47 | if (unite) { 48 | 49 | object <- list( 50 | data = object$data, 51 | fc = do.call(rbind, purrr::map(seq_along(object$fc), ~object$fc[[.x]] |> 52 | dplyr::mutate(fc = .x))) |> 53 | dplyr::mutate( 54 | y = update_y_stack_unite(.data$y, .data$x, .data$type), 55 | change = dplyr::case_when( 56 | is.na(dplyr::lag(.data$fc)) ~ FALSE, 57 | fc != dplyr::lag(.data$fc) ~ TRUE, 58 | TRUE ~ FALSE 59 | ) 60 | ) |> 61 | dplyr::group_by(.data$y) |> 62 | dplyr::mutate( 63 | type = dplyr::case_when( 64 | any(.data$change) ~ "stack", 65 | TRUE ~ .data$type 66 | ) 67 | ) |> 68 | dplyr::ungroup() |> 69 | dplyr::select(-"change") |> 70 | #Recalculate ids 71 | dplyr::mutate( 72 | id = dplyr::row_number() 73 | ) 74 | ) 75 | 76 | #We can only unite the boxes if either the last level of the previous flowchart or the first level of the following flowchart have only one box, or the same number of boxes. 77 | 78 | n_fc <- object$fc |> 79 | dplyr::group_by(.data$fc) |> 80 | dplyr::summarise( 81 | n_first = sum(.data$y == max(.data$y)), 82 | n_last = sum(.data$y == min(.data$y)) 83 | ) |> 84 | dplyr::mutate( 85 | n_last = dplyr::lag(.data$n_last) 86 | ) |> 87 | dplyr::filter(dplyr::row_number() != 1) 88 | 89 | if(with(n_fc, any(n_first != n_last & n_first > 1 & n_last > 1))) { 90 | cli::cli_abort( 91 | c( 92 | "Flowcharts can't be united because they have a different number of boxes in their connecting levels.", 93 | "i" = "Set {.code unite = FALSE}." 94 | ) 95 | ) 96 | } 97 | 98 | object$fc <- object$fc |> 99 | dplyr::select(-"fc") 100 | 101 | } 102 | 103 | class(object) <- "fc" 104 | 105 | object 106 | 107 | } 108 | -------------------------------------------------------------------------------- /R/fc_theme.R: -------------------------------------------------------------------------------- 1 | #' @title fc_theme 2 | #' @description This function allows you to change the appearance of all boxes of a flowchart at once. 3 | #' 4 | #' @param object fc object. 5 | #' @param just Justification for the text: left, center or right. 6 | #' @param text_color Color of the text. See the `col` parameter for \code{\link{gpar}}. 7 | #' @param text_fs Font size of the text. See the `fontsize` parameter for \code{\link{gpar}}. 8 | #' @param text_fface Font face of the text. See the `fontface` parameter for \code{\link{gpar}}. 9 | #' @param text_ffamily Changes the font family of the text. See the `fontfamily` parameter for \code{\link{gpar}}. 10 | #' @param text_padding Changes the text padding inside the box. This number has to be greater than 0. 11 | #' @param bg_fill Box background color. See the `fill` parameter for \code{\link{gpar}}. 12 | #' @param border_color Box border color. See the `col` parameter for \code{\link{gpar}}. 13 | #' @param width Width of the box. Must be an object of class \code{\link{unit}} or a number between 0 and 1. 14 | #' @param height Height of the box. Must be an object of class \code{\link{unit}} or a number between 0 and 1. 15 | #' @param just_exc Justification for the text of the exclude box: left, center or right. 16 | #' @param text_color_exc Color of the text of the exclude box. See `text_color`. 17 | #' @param text_fs_exc Font size of the text of the exclude box. See `text_fs`. 18 | #' @param text_fface_exc Font face of the text of the exclude box. See the `fontface` parameter for \code{\link{gpar}}. See `text_fface`. 19 | #' @param text_ffamily_exc Changes the font family of the text of the exclude box. See the `fontfamily` parameter for \code{\link{gpar}}. See `text_ffamily`. 20 | #' @param text_padding_exc Changes the text padding inside the exclude box. This number has to be greater than 0. 21 | #' @param bg_fill_exc Exclude box background color. See `bg_fill`. 22 | #' @param border_color_exc Box background color of the exclude box. See `border_color`. 23 | #' @param width_exc Width of the exclude box. Must be an object of class \code{\link{unit}} or a number between 0 and 1. 24 | #' @param height_exc Height of the box. Must be an object of class \code{\link{unit}} or a number between 0 and 1. 25 | #' @param text_color_title Color of the title text. 26 | #' @param text_fs_title Font size of the title text. 27 | #' @param text_fface_title Font face of the title text. See the `fontface` parameter for \code{\link{gpar}}. 28 | #' @param text_ffamily_title Changes the font family of the title text. See the `fontfamily` parameter for \code{\link{gpar}}. 29 | #' @param text_padding_title Changes the title text padding inside the box. This number has to be greater than 0. 30 | #' @param bg_fill_title Title box background color. 31 | #' @param border_color_title Title box border color. 32 | #' @param width_title Width of the title box. Must be an object of class \code{\link{unit}} or a number between 0 and 1. 33 | #' @param height_title Height of the title box. Must be an object of class \code{\link{unit}} or a number between 0 and 1. 34 | #' 35 | #' @return List with the dataset and the flowchart parameters with their modifications. 36 | #' 37 | #' @examples 38 | #' safo |> 39 | #' dplyr::filter(!is.na(group)) |> 40 | #' as_fc(label = "Randomized patients") |> 41 | #' fc_split(group) |> 42 | #' fc_theme(text_fs = 11, text_color = "#324C54", text_fface = 2, bg_fill = "#ADD8E6") |> 43 | #' fc_draw() 44 | #' 45 | #' @export 46 | 47 | fc_theme <- function(object, just = NULL, text_color = NULL, text_fs = NULL, text_fface = NULL, text_ffamily = NULL, text_padding = NULL, bg_fill = NULL, border_color = NULL, width = NULL, height = NULL, just_exc = NULL, text_color_exc = NULL, text_fs_exc = NULL, text_fface_exc = NULL, text_ffamily_exc = NULL, text_padding_exc = NULL, bg_fill_exc = NULL, border_color_exc = NULL, width_exc = NULL, height_exc = NULL, text_color_title = NULL, text_fs_title = NULL, text_fface_title = NULL, text_ffamily_title = NULL, text_padding_title = NULL, bg_fill_title = NULL, border_color_title = NULL, width_title = NULL, height_title = NULL) { 48 | 49 | is_class(object, "fc") 50 | UseMethod("fc_theme") 51 | 52 | } 53 | 54 | fc_theme <- function(object, just = NULL, text_color = NULL, text_fs = NULL, text_fface = NULL, text_ffamily = NULL, text_padding = NULL, bg_fill = NULL, border_color = NULL, width = NULL, height = NULL, just_exc = NULL, text_color_exc = NULL, text_fs_exc = NULL, text_fface_exc = NULL, text_ffamily_exc = NULL, text_padding_exc = NULL, bg_fill_exc = NULL, border_color_exc = NULL, width_exc = NULL, height_exc = NULL, text_color_title = NULL, text_fs_title = NULL, text_fface_title = NULL, text_ffamily_title = NULL, text_padding_title = NULL, bg_fill_title = NULL, border_color_title = NULL, width_title = NULL, height_title = NULL) { 55 | 56 | #Get the arguments different from NULL in a parameterizated way 57 | arg <- rlang::fn_fmls_names() 58 | 59 | #Find what we have to change 60 | nmodify <- tibble::tibble( 61 | arg = arg[arg != "object"] 62 | ) |> 63 | dplyr::mutate( 64 | is_null = purrr::map_lgl(.data$arg, ~is.null(get(.))) 65 | ) |> 66 | dplyr::filter(!.data$is_null) |> 67 | dplyr::mutate( 68 | value = purrr::map(.data$arg, ~get(.)) 69 | ) 70 | 71 | nmodify_exc <- nmodify |> 72 | dplyr::filter(grepl("_exc$", .data$arg)) |> 73 | dplyr::mutate( 74 | arg = gsub("_exc$", "", .data$arg) 75 | ) 76 | 77 | nmodify_title <- nmodify |> 78 | dplyr::filter(grepl("_title$", .data$arg)) |> 79 | dplyr::mutate( 80 | arg = gsub("_title$", "", .data$arg) 81 | ) 82 | 83 | nmodify_rest <- nmodify |> 84 | dplyr::filter(!grepl("_title$", .data$arg) & !grepl("_exc$", .data$arg)) 85 | 86 | if(nrow(nmodify) > 0) { 87 | 88 | #Change it 89 | if(nrow(nmodify_rest) > 0) { 90 | object$fc <- object$fc |> 91 | dplyr::mutate(dplyr::across(nmodify_rest$arg, ~dplyr::case_when(! .data$type %in% c("exclude", "title_split") ~ nmodify_rest$value[[which(nmodify_rest$arg == dplyr::cur_column())]], .default = .))) 92 | } 93 | 94 | if(nrow(nmodify_exc) > 0) { 95 | 96 | if(sum(object$fc$type == "exclude") == 0) { 97 | 98 | cli::cli_warn("The arguments for the excluded box parameters were not applied because no excluded boxes were found in the flowchart. Therefore, no change was applied for these boxes.") 99 | 100 | } 101 | 102 | #Change the excluded boxes 103 | object$fc <- object$fc |> 104 | dplyr::mutate(dplyr::across(nmodify_exc$arg, ~dplyr::case_when(.data$type == "exclude" ~ nmodify_exc$value[[which(nmodify_exc$arg == dplyr::cur_column())]], .default = .))) 105 | 106 | } 107 | 108 | if(nrow(nmodify_title) > 0) { 109 | 110 | if(sum(object$fc$type == "title_split") == 0) { 111 | 112 | cli::cli_warn("The arguments for the title box parameters were not applied because no title boxes were found in the flowchart. Therefore, no change was applied for these boxes.") 113 | 114 | } 115 | 116 | #Change the title boxes 117 | object$fc <- object$fc |> 118 | dplyr::mutate(dplyr::across(nmodify_title$arg, ~dplyr::case_when(.data$type == "title_split" ~ nmodify_title$value[[which(nmodify_title$arg == dplyr::cur_column())]], .default = .))) 119 | 120 | } 121 | 122 | } else { 123 | 124 | cli::cli_warn("No parameter will be modified as all arguments are set to {.val NULL}.") 125 | 126 | } 127 | 128 | object 129 | 130 | 131 | } 132 | -------------------------------------------------------------------------------- /R/fc_view.R: -------------------------------------------------------------------------------- 1 | #' @title fc_view 2 | #' @description This function allows you to return either the data stored in `$data` or the flowchart information stored in `$fc`. 3 | #' 4 | #' @param object fc object that we want to access. 5 | #' @param what Choose "data" to return the data associated to the flowchart stored in `$data` or "fc" to return the flowchart information stored in `$fc`. 6 | #' @return Returns a tibble. Either `$data` or `$fc`. 7 | #' 8 | #' @examples 9 | #' #Return the data associated to the flowchart 10 | #' safo |> 11 | #' as_fc(label = "Patients assessed for eligibility") |> 12 | #' fc_filter(!is.na(group), label = "Randomized", show_exc = TRUE) |> 13 | #' fc_view("data") 14 | #' 15 | #' #Return the flowchart information 16 | #' safo |> 17 | #' as_fc(label = "Patients assessed for eligibility") |> 18 | #' fc_filter(!is.na(group), label = "Randomized", show_exc = TRUE) |> 19 | #' fc_view("fc") 20 | #' 21 | #' @export 22 | 23 | fc_view <- function(object, what) { 24 | 25 | is_class(object, "fc") 26 | UseMethod("fc_view") 27 | 28 | } 29 | 30 | #' @export 31 | #' @importFrom rlang .data 32 | 33 | fc_view.fc <- function(object, what) { 34 | 35 | if(!what %in% c("data", "fc")) { 36 | cli::cli_abort("{.arg what} argument must be one of {.val data} or {.val fc}.") 37 | } 38 | 39 | object[[what]] 40 | 41 | } 42 | -------------------------------------------------------------------------------- /R/safo.R: -------------------------------------------------------------------------------- 1 | #' Random generated dataset from the SAFO study 2 | #' 3 | #' This dataset is a random generated dataset to reproduce the numbers needed to generate the flowchart of the SAFO study. SAFO is an open-label, multicenter, phase III–IV superiority randomized clinical trial to assess whether cloxacillin plus fosfomycin administered for the initial 7-days of therapy achieves better treatment success than cloxacillin alone in hospitalized patients with MSSA bacteremia. 4 | #' 5 | #' @docType data 6 | #' @keywords datasets 7 | #' @usage data(safo) 8 | #' 9 | #' @format A data frame with 925 rows and 21 columns 10 | #' \describe{ 11 | #' \item{id:}{Identifier of each patient. This information does not match the real data.} 12 | #' \item{inclusion_crit:}{The patient not met the inclusion criteria?} 13 | #' \item{exclusion_crit:}{The patient met the exclusion criteria?} 14 | #' \item{chronic_heart_failure:}{Exc1: Chronic heart failure?} 15 | #' \item{expected_death_24h:}{Exc2: Clinical status with expected death in <24h?} 16 | #' \item{polymicrobial_bacteremia:}{Exc3: Polymicrobial bacteremia?} 17 | #' \item{conditions_affect_adhrence:}{Exc4: Conditions expected to affect adhrence to the protocol?} 18 | #' \item{susp_prosthetic_valve_endocard:}{Exc5: Suspicion of prosthetic valve endocarditis?} 19 | #' \item{severe_liver_cirrhosis:}{Exc6: Severe liver cirrhosis?} 20 | #' \item{acute_sars_cov2:}{Exc7: Acute SARS-CoV-2 infection?} 21 | #' \item{blactam_fosfomycin_hypersens:}{Exc8: Beta-lactam or fosfomycin hypersensitivity?} 22 | #' \item{other_clinical_trial:}{Exc9: Participation in another clinical trial?} 23 | #' \item{pregnancy_or_breastfeeding:}{Exc10: Pregnancy or breastfeeding?} 24 | #' \item{previous_participation:}{Exc11: Previous participation in the SAFO trial?} 25 | #' \item{myasthenia_gravis:}{Exc12: Myasthenia gravis?} 26 | #' \item{decline_part:}{The patient declined to participate?} 27 | #' \item{group:}{Randomized treatment received: cloxacilin alone / cloxacilin plus fosfomycin} 28 | #' \item{itt:}{The patient belongs to the intention to treat (ITT) group?} 29 | #' \item{reason_itt:}{Reason for exclusion from the ITT group.} 30 | #' \item{pp:}{The patient belongs to the per protocol (PP) group?} 31 | #' \item{reason_pp:}{Reason for exclusion from the PP group.} 32 | #' } 33 | #' 34 | #' @references 35 | #' Grillo, S., Pujol, M., Miró, J.M. et al. Cloxacillin plus fosfomycin versus cloxacillin alone for methicillin-susceptible Staphylococcus aureus bacteremia: a randomized trial. Nat Med 29, 2518–2525 (2023). https://doi.org/10.1038/s41591-023-02569-0 36 | #' 37 | "safo" 38 | -------------------------------------------------------------------------------- /R/utils.R: -------------------------------------------------------------------------------- 1 | # Internal functions used in the package: 2 | 3 | #' @title update_x 4 | #' @description Function to update the horizontal position of the previuosly created flow charts, to merge two flowcharts used in fc_merge(). 5 | #' 6 | #'@param x old horizontal position of the boxes 7 | #'@param i position of the flowchart within the list of flowcharts. 8 | #'@param n number of total flowcharts to merge 9 | #'@keywords internal 10 | #' 11 | update_x <- function(x, i, n) { 12 | 13 | scale <- 1/n 14 | 15 | xval <- seq((i - 1)*scale, i*scale, by = scale/(length(unique(x)) + 1)) 16 | xval <- xval[-c(1, length(xval))] 17 | 18 | as.numeric(as.character(factor(x, levels = sort(unique(x)), labels = xval))) 19 | 20 | } 21 | 22 | #' @title update_y 23 | #' @description Function to update the vertical position of the previuosly created boxes, to add the new ones with fc_split() or fc_filter(). 24 | #' 25 | #'@param y old height of the boxes 26 | #'@param type type of box 27 | #'@param x horizontal position of the boxes 28 | #'@keywords internal 29 | #' 30 | update_y <- function(y, type, x, group) { 31 | 32 | tbl_y <- tibble::tibble("y" = y, "type" = type, "x" = x, "group" = group) |> 33 | dplyr::filter(.data$type != "exclude") |> 34 | dplyr::mutate(id = dplyr::row_number()) |> 35 | dplyr::mutate( 36 | id_pre = purrr::map(dplyr::row_number(), function (rn) { 37 | if(rn == 1) { 38 | NA 39 | } else { 40 | 1:(rn - 1) 41 | } 42 | }) 43 | ) 44 | 45 | tbl_ynew <- tbl_y |> 46 | dplyr::filter(!is.na(.data$group) | is.na(.data$y)) |> 47 | dplyr::mutate( 48 | group_split = purrr::map(.data$group, ~unlist(stringr::str_split(., " // "))), 49 | all_groups = purrr::map(.data$group_split, function (x) purrr::map_chr(rev(1:length(x)), ~paste(x[1:.], collapse = " // "))), 50 | id_same_group = purrr::map2(.data$id_pre, .data$all_groups, function (x, y) { 51 | if(!all(is.na(x))) { 52 | x[purrr::map_lgl(x, ~is.na(tbl_y$group[.]) | any(y %in% tbl_y$group[.]))] 53 | } else { 54 | NA 55 | } 56 | }) 57 | ) 58 | 59 | for(i in 1:nrow(tbl_ynew)) { 60 | 61 | tbl_yadd <- tbl_y |> 62 | dplyr::filter(.data$id %in% c(tbl_ynew$id[i], tbl_ynew$id_same_group[[i]])) |> 63 | dplyr::mutate( 64 | nboxes = dplyr::n(), 65 | y = setdiff(rev(seq(0, 1, by = 1/(dplyr::n() + 1))), c(0, 1)) 66 | ) |> 67 | dplyr::select("y", "id", "nboxes") |> 68 | dplyr::rename_all(~dplyr::case_when(. != "id" ~ stringr::str_glue("{.}{i}"), .default = .)) 69 | 70 | tbl_y <- tbl_y |> 71 | dplyr::left_join(tbl_yadd, by = "id") 72 | 73 | } 74 | 75 | tbl_y <- tbl_y |> 76 | dplyr::group_by(y) |> 77 | tidyr::fill(tidyselect::starts_with("y"), tidyselect::starts_with("nboxes"), .direction = "downup") |> 78 | dplyr::rowwise() |> 79 | dplyr::mutate( 80 | nmax = as.numeric(which.max(dplyr::across(tidyselect::starts_with("nboxes"), ~ .))) 81 | ) 82 | 83 | id_exc <- which(type == "exclude") 84 | 85 | if(length(id_exc) > 0) { 86 | y[-id_exc] <- purrr::map_dbl(1:nrow(tbl_y), ~tbl_y[[paste0("y", tbl_y$nmax[.])]][.]) 87 | } else { 88 | y <- purrr::map_dbl(1:nrow(tbl_y), ~tbl_y[[paste0("y", tbl_y$nmax[.])]][.]) 89 | } 90 | 91 | #Update those of type exclude (they have to be in-between the two boxes) 92 | if(length(id_exc) > 0) { 93 | for(i in 1:length(id_exc)) { 94 | 95 | #Find the two boxes, one above another below the exclude box. 96 | x_filt <- x[id_exc[i] - 1] 97 | id_par <- which(x == x_filt) 98 | id_par <- utils::tail(id_par[id_par < (id_exc[i] - 1)], 1) 99 | y[id_exc[i]] <- (y[id_par] + y[id_exc[i] - 1])/2 100 | 101 | } 102 | } 103 | 104 | y 105 | 106 | } 107 | 108 | #' @title update_y_stack 109 | #' @description Function to update the vertical position of the previuosly created flowcharts, to stack the two flowcharts with fc_stack(). 110 | #' 111 | #'@param y old vertical position of the boxes 112 | #'@param x old horizontal position of the boxes 113 | #'@param type type of the boxes 114 | #'@param i position of the flowchart within the list of flowcharts. 115 | #'@param n number of total flowcharts to merge 116 | #'@keywords internal 117 | #' 118 | update_y_stack <- function(y, x, type, i, n) { 119 | 120 | scale <- 1/n 121 | 122 | i <- (n + 1) - i 123 | 124 | yval <- seq((i - 1)*scale, i*scale, by = scale/(length(unique(y)) + 1)) 125 | yval <- yval[-c(1, length(yval))] 126 | 127 | y <- as.numeric(as.character(factor(y, levels = sort(unique(y)), labels = yval))) 128 | 129 | #Update those of type exclude (they have to be in-between the two boxes) 130 | id_exc <- which(type == "exclude") 131 | if(length(id_exc) > 0) { 132 | for(i in 1:length(id_exc)) { 133 | 134 | #Find the two boxes, one above another below the exclude box. 135 | x_filt <- x[id_exc[i] - 1] 136 | id_par <- which(x == x_filt) 137 | id_par <- utils::tail(id_par[id_par < (id_exc[i] - 1)], 1) 138 | y[id_exc[i]] <- (y[id_par] + y[id_exc[i] - 1])/2 139 | 140 | } 141 | } 142 | 143 | y 144 | 145 | } 146 | 147 | #' @title update_y_stack_unite 148 | #' @description Function to update the vertical position of the previuosly created flowcharts, to stack the two flowcharts with fc_stack(), when `unite` is TRUE. 149 | #' 150 | #'@param y old vertical position of the boxes 151 | #'@param x old horizontal position of the boxes 152 | #'@param type type of the boxes 153 | #'@keywords internal 154 | #' 155 | update_y_stack_unite <- function(y, x, type) { 156 | 157 | yval <- y[type != "exclude"] 158 | nbox <- cumsum(!duplicated(yval)) 159 | ynew <- rev(setdiff(seq(0, 1, by = 1/(max(nbox) + 1)), c(0, 1))) 160 | yval <- ynew[nbox] 161 | 162 | y[type != "exclude"] <- yval 163 | 164 | #Update those of type exclude (they have to be in-between the two boxes) 165 | id_exc <- which(type == "exclude") 166 | if(length(id_exc) > 0) { 167 | for(i in 1:length(id_exc)) { 168 | 169 | #Find the two boxes, one above another below the exclude box. 170 | x_filt <- x[id_exc[i] - 1] 171 | id_par <- which(x == x_filt) 172 | id_par <- utils::tail(id_par[id_par < (id_exc[i] - 1)], 1) 173 | y[id_exc[i]] <- (y[id_par] + y[id_exc[i] - 1])/2 174 | 175 | } 176 | } 177 | 178 | y 179 | 180 | } 181 | 182 | 183 | #' @title is_class 184 | #' @description Function to check if an object is from a given class. 185 | #' 186 | #'@param x element to check 187 | #'@param class desired class to check 188 | #'@keywords internal 189 | #' 190 | is_class <- function(x, class) { 191 | if (!inherits(x, class)) { 192 | cli::cli_abort("Expecting object of class {.cls {class}}", call = FALSE) 193 | } 194 | } 195 | 196 | #' @title quiet_prettyNum 197 | #' @description Wrapper for `prettyNum()` that suppresses the original warning message if user `big.mark` equal to the character defined in the R environment `OutDec` option. 198 | #' 199 | #'@param x an atomic numerical or character object, possibly complex, typically a vector of real numbers. 200 | #'@param big.mark character. Used to specify the thousands separator for patient count values. 201 | #'@keywords internal 202 | #' 203 | quiet_prettyNum <- function(x, big.mark) { 204 | # Get the current decimal mark from user environment, if not set then return "." 205 | dec <- getOption("OutDec", ".") 206 | 207 | # if user specifies `big.mark = "."` and `dec == "."`, then suppress the warning that will pop up: 208 | # "'big.mark' and 'decimal.mark' are both '.', which could be confusing" 209 | if (big.mark == dec) { 210 | suppressWarnings(prettyNum(x, scientific = FALSE, big.mark = big.mark)) 211 | } else { 212 | prettyNum(x, scientific = FALSE, big.mark = big.mark) 213 | } 214 | } 215 | 216 | #' @title replace_num_in_expr 217 | #' @description Helper function for `update_numbers()`. 218 | #' 219 | #'@param expr expression in `fc$text`. 220 | #'@param row A row from the `fc` object containing `n`, `N`, and `perc` values. 221 | #'@param big.mark character. Used to specify the thousands separator for patient count values. 222 | #'@keywords internal 223 | #' 224 | replace_num_in_expr <- function(expr, row, big.mark) { 225 | if (is.null(expr)) { 226 | return(expr) 227 | } 228 | 229 | # Handle numeric values directly 230 | if (is.numeric(expr)) { 231 | if (!is.na(row$n) && identical(as.numeric(expr), as.numeric(row$n))) { 232 | return(quiet_prettyNum(expr, big.mark = big.mark)) 233 | } else if (!is.na(row$N) && identical(as.numeric(expr), as.numeric(row$N))) { 234 | return(quiet_prettyNum(expr, big.mark = big.mark)) 235 | } else { 236 | return(expr) 237 | } 238 | } 239 | 240 | # Handle character strings 241 | if (is.character(expr)) { 242 | # Try to extract and format numbers in the string 243 | formatted_text <- expr 244 | 245 | # Check for n value 246 | if (!is.na(row$n)) { 247 | n_pattern <- paste0("\\b", row$n, "\\b") 248 | if (grepl(n_pattern, formatted_text)) { 249 | n_formatted <- quiet_prettyNum(row$n, big.mark = big.mark) 250 | formatted_text <- gsub(n_pattern, n_formatted, formatted_text) 251 | } 252 | } 253 | 254 | # Check for N value 255 | if (!is.na(row$N)) { 256 | N_pattern <- paste0("\\b", row$N, "\\b") 257 | if (grepl(N_pattern, formatted_text)) { 258 | N_formatted <- quiet_prettyNum(row$N, big.mark = big.mark) 259 | formatted_text <- gsub(N_pattern, N_formatted, formatted_text) 260 | } 261 | } 262 | 263 | return(formatted_text) 264 | } 265 | 266 | # Handle language expressions (function calls) 267 | if (is.call(expr)) { 268 | # Process all arguments of function call 269 | for (i in seq_along(expr)) { 270 | expr[[i]] <- replace_num_in_expr(expr[[i]], row, big.mark) 271 | } 272 | return(expr) 273 | } 274 | # For formal expression objects 275 | else if (is.expression(expr)) { 276 | return(as.expression(lapply(expr, replace_num_in_expr, row = row, big.mark = big.mark))) 277 | } 278 | # Return as is for other types 279 | else { 280 | return(expr) 281 | } 282 | } 283 | 284 | #' @title update_numbers 285 | #' @description Updates values of `n` or `N` referenced in the `text` column when user specifies `big.mark` argument in `fc_draw`. 286 | #' 287 | #'@param object fc object that we want to draw. 288 | #'@param big.mark character. Used to specify the thousands separator for patient count values. Defaults is no separator (`""`); if not empty used as mark between every 3 digits (ex: `big.mark = ","` results in `1,000` instead of `1000`). 289 | #'@keywords internal 290 | #' 291 | update_numbers <- function(object, big.mark = "") { 292 | 293 | # Get the current decimal mark from user environment, if not set then return "." 294 | dec <- getOption("OutDec", ".") 295 | 296 | # if user specifies `big.mark == dec`, then provide informative warning 297 | if (big.mark == dec) { 298 | cli::cli_warn(c( 299 | "You have set {.code big.mark} equal to your environment's {.code OutDec} 300 | ('{dec}') - it can be confusing if your flowchart uses the same mark for both.", 301 | "i" = "Consider an alternative decimal mark.", 302 | ">" = "To change the decimal mark, run: 303 | {.code options(OutDec = \"\")}" 304 | )) 305 | } 306 | 307 | # Handle both tibble and list formats 308 | fc_list <- if(tibble::is_tibble(object$fc)) list(object$fc) else object$fc 309 | 310 | fc_list <- lapply(fc_list, function(df) { 311 | for(i in 1:nrow(df)) { 312 | row <- df[i, ] 313 | 314 | # Get the text element 315 | text_element <- row$text 316 | 317 | # Handle case where text is a character vector within a list 318 | if (is.list(text_element) && length(text_element) == 1 && is.character(text_element[[1]])) { 319 | # Format numbers in the text string 320 | if (!is.na(row$n)) { 321 | n_formatted <- quiet_prettyNum(row$n, big.mark = big.mark) 322 | df$text[[i]] <- gsub(paste0("\\b", row$n, "\\b"), n_formatted, df$text[[i]]) 323 | } 324 | 325 | if (!is.na(row$N)) { 326 | N_formatted <- quiet_prettyNum(row$N, big.mark = big.mark) 327 | df$text[[i]] <- gsub(paste0("\\b", row$N, "\\b"), N_formatted, df$text[[i]]) 328 | } 329 | } 330 | # Handle case where text is a plain character string 331 | else if (is.character(text_element)) { 332 | # Format numbers in the text string 333 | if (!is.na(row$n)) { 334 | n_formatted <- quiet_prettyNum(row$n, big.mark = big.mark) 335 | df$text[i] <- gsub(paste0("\\b", row$n, "\\b"), n_formatted, df$text[i]) 336 | } 337 | 338 | if (!is.na(row$N)) { 339 | N_formatted <- quiet_prettyNum(row$N, big.mark = big.mark) 340 | df$text[i] <- gsub(paste0("\\b", row$N, "\\b"), N_formatted, df$text[i]) 341 | } 342 | } 343 | # Handle language expression 344 | else if (is.list(text_element) && length(text_element) > 0 && is.language(text_element[[1]])) { 345 | df$text[[i]] <- replace_num_in_expr(text_element[[1]], row = row, big.mark = big.mark) 346 | } 347 | } 348 | return(df) 349 | }) 350 | 351 | # Update the object with the processed fc_list 352 | if(tibble::is_tibble(object$fc)) { 353 | object$fc <- fc_list[[1]] 354 | } else { 355 | object$fc <- fc_list 356 | } 357 | 358 | return(object) 359 | } 360 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # flowchart flowchart website 2 | 3 | [![CRAN status](https://www.r-pkg.org/badges/version/flowchart)](https://cran.r-project.org/package=flowchart)    [![R-CMD-check](https://github.com/bruigtp/flowchart/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/bruigtp/flowchart/actions/workflows/R-CMD-check.yaml)    4 | [![Codecov test coverage](https://codecov.io/gh/bruigtp/flowchart/branch/main/graph/badge.svg)](https://app.codecov.io/gh/bruigtp/flowchart?branch=main) 5 | [![](https://cranlogs.r-pkg.org/badges/flowchart)](https://cran.r-project.org/package=flowchart)    [![](https://cranlogs.r-pkg.org/badges/grand-total/flowchart)](https://cran.r-project.org/package=flowchart) 6 | 7 | 8 | ## Tidy Flowchart Generator 9 | 10 | `flowchart` is an R package for drawing participant flow diagrams directly from a dataframe using tidyverse. It provides a set of functions that can be combined with a pipe operator to create all kinds of flowcharts from a dataframe in an easy way. 11 | 12 | You can see the package in action in: https://bruigtp.github.io/flowchart/ 13 | 14 | ## How to install it? 15 | 16 | The package is available on CRAN: https://cran.r-project.org/web/packages/flowchart/index.html. 17 | ``` r 18 | install.packages("flowchart") 19 | ``` 20 | We can download the development version from the github repository: 21 | ``` r 22 | # install.packages("remotes") 23 | remotes::install_github('bruigtp/flowchart') 24 | ``` 25 | 26 | ## How it works? 27 | 28 | The following GIF provides an example of the tidy process of drawing a flowchart for a clinical trial: 29 | 30 | animated 31 | 32 | ## About 33 | 34 | Package: flowchart 35 | 36 | Type: Package 37 | 38 | Version: 0.8.0 (CRAN) 39 | 40 | Authors: Pau Satorra, João Carmezim, Natàlia Pallarès, Cristian Tebé, Kenneth A. Taylor. 41 | 42 | Maintainer: Pau Satorra 43 | 44 | License: GPL (>= 3) 45 | 46 | Encoding: UTF-8 47 | 48 | Depends: R (>= 4.1.0) 49 | -------------------------------------------------------------------------------- /_pkgdown.yml: -------------------------------------------------------------------------------- 1 | url: https://bruigtp.github.io/flowchart/ 2 | template: 3 | bootstrap: 5 4 | development: 5 | mode: auto 6 | 7 | navbar: 8 | structure: 9 | left: [intro, reference, articles, tutorials, news] 10 | right: [search, github] 11 | left: 12 | - text: Get started 13 | href: articles/flowchart.html 14 | - text: Reference 15 | href: reference/index.html 16 | - text: Articles 17 | menu: 18 | - text: Combine Flowcharts 19 | href: articles/combine-flowcharts.html 20 | - text: Customization 21 | href: articles/flowchart-customization.html 22 | - text: Example Gallery 23 | href: articles/example-gallery.html 24 | - text: News 25 | href: news/index.html 26 | 27 | reference: 28 | - title: Creating flowchart 29 | desc: Functions to create a flowchart design 30 | contents: 31 | - as_fc 32 | - fc_draw 33 | - fc_filter 34 | - fc_split 35 | - title: Customizing flowchart 36 | desc: Function to customize a flowchart 37 | contents: 38 | - fc_theme 39 | - fc_modify 40 | - title: Combining flowcharts 41 | desc: Functions to combine different flowcharts 42 | contents: 43 | - fc_merge 44 | - fc_stack 45 | - title: Exporting flowchart 46 | desc: Function to export a flowchart 47 | contents: fc_export 48 | - title: View flowchart elements 49 | desc: Function to return $data or $fc 50 | contents: fc_view 51 | - title: Built-in datasets 52 | desc: Datasets that are included in the package for testing 53 | contents: 54 | - safo 55 | 56 | -------------------------------------------------------------------------------- /codecov.yml: -------------------------------------------------------------------------------- 1 | comment: false 2 | 3 | coverage: 4 | status: 5 | project: 6 | default: 7 | target: auto 8 | threshold: 1% 9 | informational: true 10 | patch: 11 | default: 12 | target: auto 13 | threshold: 1% 14 | informational: true 15 | -------------------------------------------------------------------------------- /data-raw/flowchart_example.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bruigtp/flowchart/5f107b9abf49513405e4e8311ffe952f6a1a3763/data-raw/flowchart_example.gif -------------------------------------------------------------------------------- /data/safo.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bruigtp/flowchart/5f107b9abf49513405e4e8311ffe952f6a1a3763/data/safo.rda -------------------------------------------------------------------------------- /flowchart.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | 15 | AutoAppendNewline: Yes 16 | StripTrailingWhitespace: Yes 17 | 18 | BuildType: Package 19 | PackageUseDevtools: Yes 20 | PackageInstallArgs: --no-multiarch --with-keep.source 21 | -------------------------------------------------------------------------------- /man/as_fc.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/as_fc.R 3 | \name{as_fc} 4 | \alias{as_fc} 5 | \title{as_fc} 6 | \usage{ 7 | as_fc( 8 | .data = NULL, 9 | N = NULL, 10 | label = "Initial dataframe", 11 | text_pattern = "{label}\\n{N}", 12 | just = "center", 13 | text_color = "black", 14 | text_fs = 8, 15 | text_fface = 1, 16 | text_ffamily = NA, 17 | text_padding = 1, 18 | bg_fill = "white", 19 | border_color = "black", 20 | width = NA, 21 | height = NA, 22 | hide = FALSE 23 | ) 24 | } 25 | \arguments{ 26 | \item{.data}{Data frame to be initialised as a flowchart.} 27 | 28 | \item{N}{Number of rows of the study in case `.data` is NULL.} 29 | 30 | \item{label}{Character or expression with the text that will be shown in the box.} 31 | 32 | \item{text_pattern}{Character or expression defining the structure that will have the text in each of the boxes. It recognizes label, n, N and perc within brackets. For default it is "\{label\}\\n \{n\}". If text_pattern or label is an expression, the label is always placed at the beginning of the pattern, followed by a line break where the structure specified by text_pattern is placed.} 33 | 34 | \item{just}{Justification for the text: left, center or right. Default is center.} 35 | 36 | \item{text_color}{Color of the text. It is black by default. See the `col` parameter for \code{\link{gpar}}.} 37 | 38 | \item{text_fs}{Font size of the text. It is 8 by default. See the `fontsize` parameter for \code{\link{gpar}}.} 39 | 40 | \item{text_fface}{Font face of the text. It is 1 by default. See the `fontface` parameter for \code{\link{gpar}}.} 41 | 42 | \item{text_ffamily}{Changes the font family of the text. Default is NA. See the `fontfamily` parameter for \code{\link{gpar}}.} 43 | 44 | \item{text_padding}{Changes the text padding inside the box. Default is 1. This number has to be greater than 0.} 45 | 46 | \item{bg_fill}{Box background color. It is white by default. See the `fill` parameter for \code{\link{gpar}}.} 47 | 48 | \item{border_color}{Box border color. It is black by default. See the `col` parameter for \code{\link{gpar}}.} 49 | 50 | \item{width}{Width of the box. If NA, it automatically adjusts to the content (default). Must be an object of class \code{\link{unit}} or a number between 0 and 1.} 51 | 52 | \item{height}{Height of the box. If NA, it automatically adjusts to the content (default). Must be an object of class \code{\link{unit}} or a number between 0 and 1.} 53 | 54 | \item{hide}{Logical value to hide the initial box or not. Default is FALSE. hide = TRUE can only be combined with fc_split().} 55 | } 56 | \value{ 57 | List with the dataset and the initialized flowchart parameters. 58 | } 59 | \description{ 60 | This function allows to initialize a flow chart given any database. It will create a fc object showing the number of rows of the database. If a database is not available, the user can instead directly enter the number of rows in the study. 61 | } 62 | \examples{ 63 | safo |> 64 | as_fc(label = "Patients assessed for eligibility") |> 65 | fc_draw() 66 | 67 | } 68 | -------------------------------------------------------------------------------- /man/fc_draw.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/fc_draw.R 3 | \name{fc_draw} 4 | \alias{fc_draw} 5 | \title{fc_draw} 6 | \usage{ 7 | fc_draw( 8 | object, 9 | big.mark = "", 10 | box_corners = "round", 11 | arrow_angle = 30, 12 | arrow_length = grid::unit(0.1, "inches"), 13 | arrow_ends = "last", 14 | arrow_type = "closed", 15 | title = NULL, 16 | title_x = 0.5, 17 | title_y = 0.9, 18 | title_color = "black", 19 | title_fs = 15, 20 | title_fface = 2, 21 | title_ffamily = NULL, 22 | canvas_bg = "white" 23 | ) 24 | } 25 | \arguments{ 26 | \item{object}{fc object that we want to draw.} 27 | 28 | \item{big.mark}{character. Used to specify the thousands separator for patient count values. Defaults is no separator (`""`); if not empty used as mark between every 3 digits (ex: `big.mark = ","` results in `1,000` instead of `1000`).} 29 | 30 | \item{box_corners}{Indicator of whether to draw boxes with round (`"round"`) vs non-round (`"sharp"`) corners. Default is `"round"`.} 31 | 32 | \item{arrow_angle}{The angle of the arrow head in degrees, as in `arrow`.} 33 | 34 | \item{arrow_length}{A unit specifying the length of the arrow head (from tip to base), as in `arrow`.} 35 | 36 | \item{arrow_ends}{One of "last", "first", or "both", indicating which ends of the line to draw arrow heads, as in `arrow`.} 37 | 38 | \item{arrow_type}{One of "open" or "closed" indicating whether the arrow head should be a closed triangle, as in `arrow`.} 39 | 40 | \item{title}{The title of the flowchart. Default is NULL (no title).} 41 | 42 | \item{title_x}{x coordinate for the title. Default is 0.5.} 43 | 44 | \item{title_y}{y coordinate for the title. Default is 0.9.} 45 | 46 | \item{title_color}{Color of the title. It is black by default. See the `col` parameter for \code{\link{gpar}}.} 47 | 48 | \item{title_fs}{Font size of the title. It is 15 by default. See the `fontsize` parameter for \code{\link{gpar}}.} 49 | 50 | \item{title_fface}{Font face of the title. It is 2 by default. See the `fontface` parameter for \code{\link{gpar}}.} 51 | 52 | \item{title_ffamily}{Changes the font family of the title. Default is NA. See the `fontfamily` parameter for \code{\link{gpar}}.} 53 | 54 | \item{canvas_bg}{Background color for the entire canvas (the area behind the flowchart boxes). Default is `"white"`. Set to `"transparent"` or `NULL` for a transparent background; `"transparent"` background will only be noticeable when exporting drawn flowcharts via `fc_export()` and is compatible with all `fc_export()` formats except `"jpeg"` and `"bmp"`.} 55 | } 56 | \value{ 57 | Invisibly returns the same object that has been given to the function, with the given arguments to draw the flowchart stored in the attributes. 58 | } 59 | \description{ 60 | This function allows to draw the flowchart from a fc object. 61 | } 62 | \examples{ 63 | safo |> 64 | as_fc(label = "Patients assessed for eligibility") |> 65 | fc_filter(!is.na(group), label = "Randomized", show_exc = TRUE) |> 66 | fc_split(group) |> 67 | fc_filter(itt == "Yes", label = "Included in ITT") |> 68 | fc_filter(pp == "Yes", label = "Included in PP") |> 69 | fc_draw() 70 | 71 | } 72 | -------------------------------------------------------------------------------- /man/fc_export.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/fc_export.R 3 | \name{fc_export} 4 | \alias{fc_export} 5 | \title{fc_export} 6 | \usage{ 7 | fc_export( 8 | object, 9 | filename, 10 | path = NULL, 11 | format = NULL, 12 | width = NA, 13 | height = NA, 14 | units = NULL, 15 | res = 100 16 | ) 17 | } 18 | \arguments{ 19 | \item{object}{fc object that we want to export.} 20 | 21 | \item{filename}{File name to create on disk.} 22 | 23 | \item{path}{Path of the directory to save plot to: path and filename are combined to create the fully qualified file name. Defaults to the working directory.} 24 | 25 | \item{format}{Name of the graphic device. One of 'png', 'jpeg', 'tiff', 'bmp', 'svg', or 'pdf'. If `NULL` (default), the format is guessed based on the filename extension.} 26 | 27 | \item{width, height}{Plot size in units expressed by the `units` argument. Default is 600px for bitmap formats and 6 inches for vector formats.} 28 | 29 | \item{units}{One of the following units in which the width and height arguments are expressed: "in", "cm", "mm" for vector formats and "in", "cm", "mm" or "px" for bitmap formats. If left `NULL` (default), the function will automatically use "px" for bitmap formats and "in" for vector formats.} 30 | 31 | \item{res}{The nominal resolution in ppi which will be recorded in the bitmap file, if a positive integer. Also used for units other than the default, and to convert points to pixels. Default is 100 if exporting in bitmap format. This argument is unused if exporting to a vector format.} 32 | } 33 | \value{ 34 | Invisibly returns the same object that has been given to the function. 35 | } 36 | \description{ 37 | This function allows you to export the drawn flowchart to the most popular graphic formats, including bitmap formats (png, jpeg, tiff, bmp) and vector formats (svg, pdf). For bitmap formats, it uses the `ragg` package devices when available for higher performance and higher quality output than standard raster devices provide by `grDevices`. 38 | } 39 | \details{ 40 | - **Vector Formats ('svg', 'pdf'):** These formats are ideal for graphics that need to be scaled without loss of quality. The default units for width and height are inches. If user specifies `units` other than inches ("mm" or "cm"), the function will convert the dimensions to inches using standard conversion formulas. 41 | - **Bitmap Formats ('png', 'jpeg', 'tiff', 'bmp'):** For these formats (with the exception of 'bmp'), the function uses the `ragg` package devices when available, providing higher performance and higher quality output. The default units for width and height are pixels. 42 | - **Suggested Dependencies:** For superior performance and quality bitmap outputs, it is recommended to install the `ragg` package. For exporting to 'pdf' format with enhanced features, the Cairo graphics library will be used if it is available. 43 | } 44 | \examples{ 45 | \dontrun{ 46 | safo |> 47 | as_fc(label = "Patients assessed for eligibility") |> 48 | fc_filter(!is.na(group), label = "Randomized", show_exc = TRUE) |> 49 | fc_draw() |> 50 | fc_export("flowchart.png") 51 | 52 | #Specifying size and resolution 53 | safo |> 54 | as_fc(label = "Patients assessed for eligibility") |> 55 | fc_filter(!is.na(group), label = "Randomized", show_exc = TRUE) |> 56 | fc_draw() |> 57 | fc_export("flowchart.png", width = 3000, height = 4000, res = 700) 58 | 59 | #Exporting to an SVG file 60 | safo |> 61 | as_fc(label = "Patients assessed for eligibility") |> 62 | fc_filter(!is.na(group), label = "Randomized", show_exc = TRUE) |> 63 | fc_draw() |> 64 | fc_export("flowchart.svg") 65 | 66 | #Exporting to a PDF file 67 | safo |> 68 | as_fc(label = "Patients assessed for eligibility") |> 69 | fc_filter(!is.na(group), label = "Randomized", show_exc = TRUE) |> 70 | fc_draw() |> 71 | fc_export("flowchart.pdf") 72 | } 73 | } 74 | -------------------------------------------------------------------------------- /man/fc_filter.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/fc_filter.R 3 | \name{fc_filter} 4 | \alias{fc_filter} 5 | \title{fc_filter} 6 | \usage{ 7 | fc_filter( 8 | object, 9 | filter = NULL, 10 | N = NULL, 11 | label = NULL, 12 | text_pattern = "{label}\\n {n} ({perc}\%)", 13 | perc_total = FALSE, 14 | show_exc = FALSE, 15 | direction_exc = "right", 16 | label_exc = "Excluded", 17 | text_pattern_exc = "{label}\\n {n} ({perc}\%)", 18 | sel_group = NULL, 19 | round_digits = 2, 20 | just = "center", 21 | text_color = "black", 22 | text_fs = 8, 23 | text_fface = 1, 24 | text_ffamily = NA, 25 | text_padding = 1, 26 | bg_fill = "white", 27 | border_color = "black", 28 | width = NA, 29 | height = NA, 30 | just_exc = "center", 31 | text_color_exc = "black", 32 | text_fs_exc = 6, 33 | text_fface_exc = 1, 34 | text_ffamily_exc = NA, 35 | text_padding_exc = 1, 36 | bg_fill_exc = "white", 37 | border_color_exc = "black", 38 | offset_exc = NULL, 39 | width_exc = NA, 40 | height_exc = NA 41 | ) 42 | } 43 | \arguments{ 44 | \item{object}{fc object that we want to filter.} 45 | 46 | \item{filter}{Expression that returns a logical value and are defined in terms of the variables in the data frame. The data base will be filtered by this expression, and it will create a box showing the number of rows satisfying this condition.} 47 | 48 | \item{N}{Number of rows after the filter in case `filter` is NULL.} 49 | 50 | \item{label}{Character or expression that will be the title of the box. By default it will be the evaluated condition.} 51 | 52 | \item{text_pattern}{Character or expression defining the structure that will have the text in each of the boxes. It recognizes label, n, N and perc within brackets. For default it is "\{label\}\\n \{n\} (\{perc\}\%)". If text_pattern or label is an expression, the label is always placed at the beginning of the pattern, followed by a line break where the structure specified by text_pattern is placed.} 53 | 54 | \item{perc_total}{logical. Should percentages be calculated using the total number of rows at the beginning of the flowchart? Default is FALSE, meaning that they will be calculated using the number at the parent leaf.} 55 | 56 | \item{show_exc}{Logical value. If TRUE a box showing the number of excluded rows will be added to the flow chart.} 57 | 58 | \item{direction_exc}{One of "left" or "right" indicating if the exclusion box goes into the left direction or in the right direction. By default is "right".} 59 | 60 | \item{label_exc}{Character or expression that will be the title of the added box showing the excluded patients. By default it will show "Excluded".} 61 | 62 | \item{text_pattern_exc}{Character or expression defining the structure that will have the text in the exclude box. It recognizes label, n, N and perc within brackets. For default it is "\{label\}\\n \{n\} (\{perc\}\%)". If text_pattern or label is an expression, the label is always placed at the beginning of the pattern, followed by a line break where the structure specified by text_pattern_exc is placed.} 63 | 64 | \item{sel_group}{Select the group in which to perform the filter. The default is NULL. Can only be used if the flowchart has previously been split. If the flowchart has more than one group, it can either be given the full name as it is stored in the `$fc` component (separated by '\\'), or it can be given as a vector with the names of each group to be selected.} 65 | 66 | \item{round_digits}{Number of digits to round percentages. It is 2 by default.} 67 | 68 | \item{just}{Justification for the text: left, center or right. Default is center.} 69 | 70 | \item{text_color}{Color of the text. It is black by default. See the `col` parameter for \code{\link{gpar}}.} 71 | 72 | \item{text_fs}{Font size of the text. It is 8 by default. See the `fontsize` parameter for \code{\link{gpar}}.} 73 | 74 | \item{text_fface}{Font face of the text. It is 1 by default. See the `fontface` parameter for \code{\link{gpar}}.} 75 | 76 | \item{text_ffamily}{Changes the font family of the text. Default is NA. See the `fontfamily` parameter for \code{\link{gpar}}.} 77 | 78 | \item{text_padding}{Changes the text padding inside the box. Default is 1. This number has to be greater than 0.} 79 | 80 | \item{bg_fill}{Box background color. It is white by default. See the `fill` parameter for \code{\link{gpar}}.} 81 | 82 | \item{border_color}{Box border color. It is black by default. See the `col` parameter for \code{\link{gpar}}.} 83 | 84 | \item{width}{Width of the box. If NA, it automatically adjusts to the content (default). Must be an object of class \code{\link{unit}} or a number between 0 and 1.} 85 | 86 | \item{height}{Height of the box. If NA, it automatically adjusts to the content (default). Must be an object of class \code{\link{unit}} or a number between 0 and 1.} 87 | 88 | \item{just_exc}{Justification for the text of the exclude box: left, center or right. Default is center.} 89 | 90 | \item{text_color_exc}{Color of the text of the exclude box. It is black by default. See `text_color`.} 91 | 92 | \item{text_fs_exc}{Font size of the text of the exclude box. It is 6 by default. See `text_fs`.} 93 | 94 | \item{text_fface_exc}{Font face of the text of the exclude box. It is 1 by default. See the `fontface` parameter for \code{\link{gpar}}. See `text_fface`.} 95 | 96 | \item{text_ffamily_exc}{Changes the font family of the text of the exclude box. Default is NA. See the `fontfamily` parameter for \code{\link{gpar}}. See `text_ffamily`.} 97 | 98 | \item{text_padding_exc}{Changes the text padding inside the exclude box. Default is 1. This number has to be greater than 0.} 99 | 100 | \item{bg_fill_exc}{Exclude box background color. It is white by default. See `bg_fill`.} 101 | 102 | \item{border_color_exc}{Box background color of the exclude box. It is black by default. See `border_color`.} 103 | 104 | \item{offset_exc}{Amount of space to add to the distance between the box and the excluded box (in the x coordinate). If positive, this distance will be larger. If negative, it will be smaller. This number has to be at least between 0 and 1 (plot limits) and the resulting x coordinate cannot exceed these plot limits. The default is NULL (no offset).} 105 | 106 | \item{width_exc}{Width of the exclude box. If NA, it automatically adjusts to the content (default). Must be an object of class \code{\link{unit}} or a number between 0 and 1.} 107 | 108 | \item{height_exc}{Height of the box. If NA, it automatically adjusts to the content (default). Must be an object of class \code{\link{unit}} or a number between 0 and 1.} 109 | } 110 | \value{ 111 | List with the filtered dataset and the flowchart parameters with the resulting filtered box. 112 | } 113 | \description{ 114 | This function allows to filter the flowchart in function of a expression that returns a logic value that are defined in terms of the variables in the database. It will generate one box per group showing the number of rows of the group that matches the condition, and will retain only those rows in the data base. 115 | } 116 | \examples{ 117 | safo |> 118 | as_fc(label = "Patients assessed for eligibility") |> 119 | fc_filter(!is.na(group), label = "Randomized", show_exc = TRUE) |> 120 | fc_draw() 121 | 122 | } 123 | -------------------------------------------------------------------------------- /man/fc_merge.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/fc_merge.R 3 | \name{fc_merge} 4 | \alias{fc_merge} 5 | \title{fc_merge} 6 | \usage{ 7 | fc_merge(fcs) 8 | } 9 | \arguments{ 10 | \item{fcs}{list with all the flowcharts that we want to merge} 11 | } 12 | \value{ 13 | List containing a list with the datasets belonging to each flowchart and another list with each of the flowcharts parameters to merge. 14 | } 15 | \description{ 16 | This function allows to combine horizontally two different flowcharts. 17 | } 18 | \examples{ 19 | # Create first flowchart for ITT 20 | fc1 <- safo |> 21 | as_fc(label = "Patients assessed for eligibility") |> 22 | fc_filter(itt == "Yes", label = "Intention to treat (ITT)") 23 | 24 | 25 | # Create second flowchart for PP 26 | fc2 <- safo |> 27 | as_fc(label = "Patients assessed for eligibility") |> 28 | fc_filter(pp == "Yes", label = "Per protocol (PP)") 29 | 30 | list(fc1, fc2) |> 31 | fc_merge() |> 32 | fc_draw() 33 | 34 | } 35 | -------------------------------------------------------------------------------- /man/fc_modify.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/fc_modify.R 3 | \name{fc_modify} 4 | \alias{fc_modify} 5 | \title{fc_modify} 6 | \usage{ 7 | fc_modify(object, fun, ...) 8 | } 9 | \arguments{ 10 | \item{object}{flowchart created as a fc object.} 11 | 12 | \item{fun}{A function or formula that will be applied to `.$fc`. If a _function_, it is used as is. If a _formula_, e.g. `fun = ~.x |> mutate(x = x + 0.2)`, it is converted to a function.} 13 | 14 | \item{...}{Additional arguments passed on to the mapped function.} 15 | } 16 | \value{ 17 | List with the dataset and the modified flowchart parameters. 18 | } 19 | \description{ 20 | This function allows to modify the `.$fc` tibble included in each fc object that contains all the parameters of the flowchart. 21 | } 22 | \examples{ 23 | #Example: let's modify the excluded box 24 | text_exc <- paste0( 25 | sum(safo$inclusion_crit == "Yes"), 26 | " not met the inclusion criteria\n", 27 | sum(safo$exclusion_crit == "Yes"), 28 | " met the exclusion criteria" 29 | ) 30 | 31 | safo |> 32 | as_fc(label = "Patients assessed for eligibility") |> 33 | fc_filter(!is.na(group), label = "Randomized", show_exc = TRUE) |> 34 | fc_modify( 35 | ~ . |> 36 | dplyr::mutate( 37 | text = ifelse(id == 3, text_exc, text), 38 | x = ifelse(id == 3, 0.75, x) 39 | ) 40 | ) |> 41 | fc_draw() 42 | 43 | } 44 | -------------------------------------------------------------------------------- /man/fc_split.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/fc_split.R 3 | \name{fc_split} 4 | \alias{fc_split} 5 | \title{fc_split} 6 | \usage{ 7 | fc_split( 8 | object, 9 | var = NULL, 10 | N = NULL, 11 | label = NULL, 12 | text_pattern = "{label}\\n {n} ({perc}\%)", 13 | perc_total = FALSE, 14 | sel_group = NULL, 15 | na.rm = FALSE, 16 | show_zero = FALSE, 17 | round_digits = 2, 18 | just = "center", 19 | text_color = "black", 20 | text_fs = 8, 21 | text_fface = 1, 22 | text_ffamily = NA, 23 | text_padding = 1, 24 | bg_fill = "white", 25 | border_color = "black", 26 | width = NA, 27 | height = NA, 28 | title = NULL, 29 | text_color_title = "black", 30 | text_fs_title = 10, 31 | text_fface_title = 1, 32 | text_ffamily_title = NA, 33 | text_padding_title = 0.6, 34 | bg_fill_title = "white", 35 | border_color_title = "black", 36 | width_title = NA, 37 | height_title = NA, 38 | offset = NULL 39 | ) 40 | } 41 | \arguments{ 42 | \item{object}{fc object that we want to split.} 43 | 44 | \item{var}{variable column of the database from which it will be splitted.} 45 | 46 | \item{N}{Number of rows after the split in case `var` is NULL.} 47 | 48 | \item{label}{Vector of characters or vector of expressions with the label of each category in order. It has to have as many elements as categories has the column. By default, it will put the labels of the categories.} 49 | 50 | \item{text_pattern}{Character or expression defining the structure that will have the text in each of the boxes. It recognizes label, n, N and perc within brackets. For default it is "\{label\}\\n \{n\} (\{perc\}\%)". If text_pattern or label is an expression, the label is always placed at the beginning of the pattern, followed by a line break where the structure specified by text_pattern is placed.} 51 | 52 | \item{perc_total}{logical. Should percentages be calculated using the total number of rows at the beginning of the flowchart? Default is FALSE, meaning that they will be calculated using the number at the parent leaf.} 53 | 54 | \item{sel_group}{Select the group in which to perform the filter. The default is NULL. Can only be used if the flowchart has previously been split. If the flowchart has more than one group, it can either be given the full name as it is stored in the `$fc` component (separated by '\\'), or it can be given as a vector with the names of each group to be selected.} 55 | 56 | \item{na.rm}{logical. Should missing values of the grouping variable be removed? Default is FALSE.} 57 | 58 | \item{show_zero}{logical. Should the levels of the grouping variable that don't have data be shown? Default is FALSE.} 59 | 60 | \item{round_digits}{Number of digits to round percentages. It is 2 by default.} 61 | 62 | \item{just}{Justification for the text: left, center or right. Default is center.} 63 | 64 | \item{text_color}{Color of the text. It is black by default.} 65 | 66 | \item{text_fs}{Font size of the text. It is 8 by default.} 67 | 68 | \item{text_fface}{Font face of the text. It is 1 by default. See the `fontface` parameter for \code{\link{gpar}}.} 69 | 70 | \item{text_ffamily}{Changes the font family of the text. Default is NA. See the `fontfamily` parameter for \code{\link{gpar}}.} 71 | 72 | \item{text_padding}{Changes the text padding inside the box. Default is 1. This number has to be greater than 0.} 73 | 74 | \item{bg_fill}{Box background color. It is white by default.} 75 | 76 | \item{border_color}{Box border color. It is black by default.} 77 | 78 | \item{width}{Width of the box. If NA, it automatically adjusts to the content (default). Must be an object of class \code{\link{unit}} or a number between 0 and 1.} 79 | 80 | \item{height}{Height of the box. If NA, it automatically adjusts to the content (default). Must be an object of class \code{\link{unit}} or a number between 0 and 1.} 81 | 82 | \item{title}{Add a title box to the split. Default is NULL. It can only be used when there are only two resulting boxes after the split.} 83 | 84 | \item{text_color_title}{Color of the title text. It is black by default.} 85 | 86 | \item{text_fs_title}{Font size of the title text. It is 8 by default.} 87 | 88 | \item{text_fface_title}{Font face of the title text. It is 1 by default. See the `fontface` parameter for \code{\link{gpar}}.} 89 | 90 | \item{text_ffamily_title}{Changes the font family of the title text. Default is NA. See the `fontfamily` parameter for \code{\link{gpar}}.} 91 | 92 | \item{text_padding_title}{Changes the title text padding inside the box. Default is 1. This number has to be greater than 0.} 93 | 94 | \item{bg_fill_title}{Title box background color. It is white by default.} 95 | 96 | \item{border_color_title}{Title box border color. It is black by default.} 97 | 98 | \item{width_title}{Width of the title box. If NA, it automatically adjusts to the content (default). Must be an object of class \code{\link{unit}} or a number between 0 and 1.} 99 | 100 | \item{height_title}{Height of the title box. If NA, it automatically adjusts to the content (default). Must be an object of class \code{\link{unit}} or a number between 0 and 1.} 101 | 102 | \item{offset}{Amount of space to add to the distance between boxes (in the x coordinate). If positive, this distance will be larger. If negative, it will be smaller. This number has to be at least between 0 and 1 (plot limits) and the resulting x coordinate cannot exceed these plot limits. The default is NULL (no offset).} 103 | } 104 | \value{ 105 | List with the dataset grouped by the splitting variable and the flowchart parameters with the resulting split. 106 | } 107 | \description{ 108 | This function allows to split the flowchart in function of the categories of a column of the database. It will generate as many boxes as categories has the column showing in each one the frequency of each category. It will additionally group the database per this column. 109 | } 110 | \examples{ 111 | safo |> 112 | dplyr::filter(!is.na(group)) |> 113 | as_fc(label = "Randomized patients") |> 114 | fc_split(group) |> 115 | fc_draw() 116 | 117 | } 118 | -------------------------------------------------------------------------------- /man/fc_stack.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/fc_stack.R 3 | \name{fc_stack} 4 | \alias{fc_stack} 5 | \title{fc_stack} 6 | \usage{ 7 | fc_stack(fcs, unite = FALSE) 8 | } 9 | \arguments{ 10 | \item{fcs}{list with all the flowcharts that we want to merge} 11 | 12 | \item{unite}{logical value if the boxes have to be united or not. Default is FALSE.} 13 | } 14 | \value{ 15 | List containing a list with the datasets belonging to each flowchart and the flowchart parameters combining all the flowcharts. 16 | } 17 | \description{ 18 | This function allows to combine vertically two different flowcharts. 19 | } 20 | \examples{ 21 | # Create first flowchart for ITT 22 | fc1 <- safo |> 23 | as_fc(label = "Patients assessed for eligibility") |> 24 | fc_filter(itt == "Yes", label = "Intention to treat (ITT)") 25 | 26 | 27 | # Create second flowchart for PP 28 | fc2 <- safo |> 29 | as_fc(label = "Patients assessed for eligibility") |> 30 | fc_filter(pp == "Yes", label = "Per protocol (PP)") 31 | 32 | list(fc1, fc2) |> 33 | fc_stack() |> 34 | fc_draw() 35 | 36 | } 37 | -------------------------------------------------------------------------------- /man/fc_theme.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/fc_theme.R 3 | \name{fc_theme} 4 | \alias{fc_theme} 5 | \title{fc_theme} 6 | \usage{ 7 | fc_theme( 8 | object, 9 | just = NULL, 10 | text_color = NULL, 11 | text_fs = NULL, 12 | text_fface = NULL, 13 | text_ffamily = NULL, 14 | text_padding = NULL, 15 | bg_fill = NULL, 16 | border_color = NULL, 17 | width = NULL, 18 | height = NULL, 19 | just_exc = NULL, 20 | text_color_exc = NULL, 21 | text_fs_exc = NULL, 22 | text_fface_exc = NULL, 23 | text_ffamily_exc = NULL, 24 | text_padding_exc = NULL, 25 | bg_fill_exc = NULL, 26 | border_color_exc = NULL, 27 | width_exc = NULL, 28 | height_exc = NULL, 29 | text_color_title = NULL, 30 | text_fs_title = NULL, 31 | text_fface_title = NULL, 32 | text_ffamily_title = NULL, 33 | text_padding_title = NULL, 34 | bg_fill_title = NULL, 35 | border_color_title = NULL, 36 | width_title = NULL, 37 | height_title = NULL 38 | ) 39 | } 40 | \arguments{ 41 | \item{object}{fc object.} 42 | 43 | \item{just}{Justification for the text: left, center or right.} 44 | 45 | \item{text_color}{Color of the text. See the `col` parameter for \code{\link{gpar}}.} 46 | 47 | \item{text_fs}{Font size of the text. See the `fontsize` parameter for \code{\link{gpar}}.} 48 | 49 | \item{text_fface}{Font face of the text. See the `fontface` parameter for \code{\link{gpar}}.} 50 | 51 | \item{text_ffamily}{Changes the font family of the text. See the `fontfamily` parameter for \code{\link{gpar}}.} 52 | 53 | \item{text_padding}{Changes the text padding inside the box. This number has to be greater than 0.} 54 | 55 | \item{bg_fill}{Box background color. See the `fill` parameter for \code{\link{gpar}}.} 56 | 57 | \item{border_color}{Box border color. See the `col` parameter for \code{\link{gpar}}.} 58 | 59 | \item{width}{Width of the box. Must be an object of class \code{\link{unit}} or a number between 0 and 1.} 60 | 61 | \item{height}{Height of the box. Must be an object of class \code{\link{unit}} or a number between 0 and 1.} 62 | 63 | \item{just_exc}{Justification for the text of the exclude box: left, center or right.} 64 | 65 | \item{text_color_exc}{Color of the text of the exclude box. See `text_color`.} 66 | 67 | \item{text_fs_exc}{Font size of the text of the exclude box. See `text_fs`.} 68 | 69 | \item{text_fface_exc}{Font face of the text of the exclude box. See the `fontface` parameter for \code{\link{gpar}}. See `text_fface`.} 70 | 71 | \item{text_ffamily_exc}{Changes the font family of the text of the exclude box. See the `fontfamily` parameter for \code{\link{gpar}}. See `text_ffamily`.} 72 | 73 | \item{text_padding_exc}{Changes the text padding inside the exclude box. This number has to be greater than 0.} 74 | 75 | \item{bg_fill_exc}{Exclude box background color. See `bg_fill`.} 76 | 77 | \item{border_color_exc}{Box background color of the exclude box. See `border_color`.} 78 | 79 | \item{width_exc}{Width of the exclude box. Must be an object of class \code{\link{unit}} or a number between 0 and 1.} 80 | 81 | \item{height_exc}{Height of the box. Must be an object of class \code{\link{unit}} or a number between 0 and 1.} 82 | 83 | \item{text_color_title}{Color of the title text.} 84 | 85 | \item{text_fs_title}{Font size of the title text.} 86 | 87 | \item{text_fface_title}{Font face of the title text. See the `fontface` parameter for \code{\link{gpar}}.} 88 | 89 | \item{text_ffamily_title}{Changes the font family of the title text. See the `fontfamily` parameter for \code{\link{gpar}}.} 90 | 91 | \item{text_padding_title}{Changes the title text padding inside the box. This number has to be greater than 0.} 92 | 93 | \item{bg_fill_title}{Title box background color.} 94 | 95 | \item{border_color_title}{Title box border color.} 96 | 97 | \item{width_title}{Width of the title box. Must be an object of class \code{\link{unit}} or a number between 0 and 1.} 98 | 99 | \item{height_title}{Height of the title box. Must be an object of class \code{\link{unit}} or a number between 0 and 1.} 100 | } 101 | \value{ 102 | List with the dataset and the flowchart parameters with their modifications. 103 | } 104 | \description{ 105 | This function allows you to change the appearance of all boxes of a flowchart at once. 106 | } 107 | \examples{ 108 | safo |> 109 | dplyr::filter(!is.na(group)) |> 110 | as_fc(label = "Randomized patients") |> 111 | fc_split(group) |> 112 | fc_theme(text_fs = 11, text_color = "#324C54", text_fface = 2, bg_fill = "#ADD8E6") |> 113 | fc_draw() 114 | 115 | } 116 | -------------------------------------------------------------------------------- /man/fc_view.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/fc_view.R 3 | \name{fc_view} 4 | \alias{fc_view} 5 | \title{fc_view} 6 | \usage{ 7 | fc_view(object, what) 8 | } 9 | \arguments{ 10 | \item{object}{fc object that we want to access.} 11 | 12 | \item{what}{Choose "data" to return the data associated to the flowchart stored in `$data` or "fc" to return the flowchart information stored in `$fc`.} 13 | } 14 | \value{ 15 | Returns a tibble. Either `$data` or `$fc`. 16 | } 17 | \description{ 18 | This function allows you to return either the data stored in `$data` or the flowchart information stored in `$fc`. 19 | } 20 | \examples{ 21 | #Return the data associated to the flowchart 22 | safo |> 23 | as_fc(label = "Patients assessed for eligibility") |> 24 | fc_filter(!is.na(group), label = "Randomized", show_exc = TRUE) |> 25 | fc_view("data") 26 | 27 | #Return the flowchart information 28 | safo |> 29 | as_fc(label = "Patients assessed for eligibility") |> 30 | fc_filter(!is.na(group), label = "Randomized", show_exc = TRUE) |> 31 | fc_view("fc") 32 | 33 | } 34 | -------------------------------------------------------------------------------- /man/figures/Thumbs.db: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bruigtp/flowchart/5f107b9abf49513405e4e8311ffe952f6a1a3763/man/figures/Thumbs.db -------------------------------------------------------------------------------- /man/figures/logo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bruigtp/flowchart/5f107b9abf49513405e4e8311ffe952f6a1a3763/man/figures/logo.png -------------------------------------------------------------------------------- /man/is_class.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{is_class} 4 | \alias{is_class} 5 | \title{is_class} 6 | \usage{ 7 | is_class(x, class) 8 | } 9 | \arguments{ 10 | \item{x}{element to check} 11 | 12 | \item{class}{desired class to check} 13 | } 14 | \description{ 15 | Function to check if an object is from a given class. 16 | } 17 | \keyword{internal} 18 | -------------------------------------------------------------------------------- /man/quiet_prettyNum.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{quiet_prettyNum} 4 | \alias{quiet_prettyNum} 5 | \title{quiet_prettyNum} 6 | \usage{ 7 | quiet_prettyNum(x, big.mark) 8 | } 9 | \arguments{ 10 | \item{x}{an atomic numerical or character object, possibly complex, typically a vector of real numbers.} 11 | 12 | \item{big.mark}{character. Used to specify the thousands separator for patient count values.} 13 | } 14 | \description{ 15 | Wrapper for `prettyNum()` that suppresses the original warning message if user `big.mark` equal to the character defined in the R environment `OutDec` option. 16 | } 17 | \keyword{internal} 18 | -------------------------------------------------------------------------------- /man/replace_num_in_expr.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{replace_num_in_expr} 4 | \alias{replace_num_in_expr} 5 | \title{replace_num_in_expr} 6 | \usage{ 7 | replace_num_in_expr(expr, row, big.mark) 8 | } 9 | \arguments{ 10 | \item{expr}{expression in `fc$text`.} 11 | 12 | \item{row}{A row from the `fc` object containing `n`, `N`, and `perc` values.} 13 | 14 | \item{big.mark}{character. Used to specify the thousands separator for patient count values.} 15 | } 16 | \description{ 17 | Helper function for `update_numbers()`. 18 | } 19 | \keyword{internal} 20 | -------------------------------------------------------------------------------- /man/safo.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/safo.R 3 | \docType{data} 4 | \name{safo} 5 | \alias{safo} 6 | \title{Random generated dataset from the SAFO study} 7 | \format{ 8 | A data frame with 925 rows and 21 columns 9 | \describe{ 10 | \item{id:}{Identifier of each patient. This information does not match the real data.} 11 | \item{inclusion_crit:}{The patient not met the inclusion criteria?} 12 | \item{exclusion_crit:}{The patient met the exclusion criteria?} 13 | \item{chronic_heart_failure:}{Exc1: Chronic heart failure?} 14 | \item{expected_death_24h:}{Exc2: Clinical status with expected death in <24h?} 15 | \item{polymicrobial_bacteremia:}{Exc3: Polymicrobial bacteremia?} 16 | \item{conditions_affect_adhrence:}{Exc4: Conditions expected to affect adhrence to the protocol?} 17 | \item{susp_prosthetic_valve_endocard:}{Exc5: Suspicion of prosthetic valve endocarditis?} 18 | \item{severe_liver_cirrhosis:}{Exc6: Severe liver cirrhosis?} 19 | \item{acute_sars_cov2:}{Exc7: Acute SARS-CoV-2 infection?} 20 | \item{blactam_fosfomycin_hypersens:}{Exc8: Beta-lactam or fosfomycin hypersensitivity?} 21 | \item{other_clinical_trial:}{Exc9: Participation in another clinical trial?} 22 | \item{pregnancy_or_breastfeeding:}{Exc10: Pregnancy or breastfeeding?} 23 | \item{previous_participation:}{Exc11: Previous participation in the SAFO trial?} 24 | \item{myasthenia_gravis:}{Exc12: Myasthenia gravis?} 25 | \item{decline_part:}{The patient declined to participate?} 26 | \item{group:}{Randomized treatment received: cloxacilin alone / cloxacilin plus fosfomycin} 27 | \item{itt:}{The patient belongs to the intention to treat (ITT) group?} 28 | \item{reason_itt:}{Reason for exclusion from the ITT group.} 29 | \item{pp:}{The patient belongs to the per protocol (PP) group?} 30 | \item{reason_pp:}{Reason for exclusion from the PP group.} 31 | } 32 | } 33 | \usage{ 34 | data(safo) 35 | } 36 | \description{ 37 | This dataset is a random generated dataset to reproduce the numbers needed to generate the flowchart of the SAFO study. SAFO is an open-label, multicenter, phase III–IV superiority randomized clinical trial to assess whether cloxacillin plus fosfomycin administered for the initial 7-days of therapy achieves better treatment success than cloxacillin alone in hospitalized patients with MSSA bacteremia. 38 | } 39 | \references{ 40 | Grillo, S., Pujol, M., Miró, J.M. et al. Cloxacillin plus fosfomycin versus cloxacillin alone for methicillin-susceptible Staphylococcus aureus bacteremia: a randomized trial. Nat Med 29, 2518–2525 (2023). https://doi.org/10.1038/s41591-023-02569-0 41 | } 42 | \keyword{datasets} 43 | -------------------------------------------------------------------------------- /man/update_numbers.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{update_numbers} 4 | \alias{update_numbers} 5 | \title{update_numbers} 6 | \usage{ 7 | update_numbers(object, big.mark = "") 8 | } 9 | \arguments{ 10 | \item{object}{fc object that we want to draw.} 11 | 12 | \item{big.mark}{character. Used to specify the thousands separator for patient count values. Defaults is no separator (`""`); if not empty used as mark between every 3 digits (ex: `big.mark = ","` results in `1,000` instead of `1000`).} 13 | } 14 | \description{ 15 | Updates values of `n` or `N` referenced in the `text` column when user specifies `big.mark` argument in `fc_draw`. 16 | } 17 | \keyword{internal} 18 | -------------------------------------------------------------------------------- /man/update_x.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{update_x} 4 | \alias{update_x} 5 | \title{update_x} 6 | \usage{ 7 | update_x(x, i, n) 8 | } 9 | \arguments{ 10 | \item{x}{old horizontal position of the boxes} 11 | 12 | \item{i}{position of the flowchart within the list of flowcharts.} 13 | 14 | \item{n}{number of total flowcharts to merge} 15 | } 16 | \description{ 17 | Function to update the horizontal position of the previuosly created flow charts, to merge two flowcharts used in fc_merge(). 18 | } 19 | \keyword{internal} 20 | -------------------------------------------------------------------------------- /man/update_y.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{update_y} 4 | \alias{update_y} 5 | \title{update_y} 6 | \usage{ 7 | update_y(y, type, x, group) 8 | } 9 | \arguments{ 10 | \item{y}{old height of the boxes} 11 | 12 | \item{type}{type of box} 13 | 14 | \item{x}{horizontal position of the boxes} 15 | } 16 | \description{ 17 | Function to update the vertical position of the previuosly created boxes, to add the new ones with fc_split() or fc_filter(). 18 | } 19 | \keyword{internal} 20 | -------------------------------------------------------------------------------- /man/update_y_stack.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{update_y_stack} 4 | \alias{update_y_stack} 5 | \title{update_y_stack} 6 | \usage{ 7 | update_y_stack(y, x, type, i, n) 8 | } 9 | \arguments{ 10 | \item{y}{old vertical position of the boxes} 11 | 12 | \item{x}{old horizontal position of the boxes} 13 | 14 | \item{type}{type of the boxes} 15 | 16 | \item{i}{position of the flowchart within the list of flowcharts.} 17 | 18 | \item{n}{number of total flowcharts to merge} 19 | } 20 | \description{ 21 | Function to update the vertical position of the previuosly created flowcharts, to stack the two flowcharts with fc_stack(). 22 | } 23 | \keyword{internal} 24 | -------------------------------------------------------------------------------- /man/update_y_stack_unite.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{update_y_stack_unite} 4 | \alias{update_y_stack_unite} 5 | \title{update_y_stack_unite} 6 | \usage{ 7 | update_y_stack_unite(y, x, type) 8 | } 9 | \arguments{ 10 | \item{y}{old vertical position of the boxes} 11 | 12 | \item{x}{old horizontal position of the boxes} 13 | 14 | \item{type}{type of the boxes} 15 | } 16 | \description{ 17 | Function to update the vertical position of the previuosly created flowcharts, to stack the two flowcharts with fc_stack(), when `unite` is TRUE. 18 | } 19 | \keyword{internal} 20 | -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bruigtp/flowchart/5f107b9abf49513405e4e8311ffe952f6a1a3763/pkgdown/favicon/apple-touch-icon.png -------------------------------------------------------------------------------- /pkgdown/favicon/favicon-96x96.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bruigtp/flowchart/5f107b9abf49513405e4e8311ffe952f6a1a3763/pkgdown/favicon/favicon-96x96.png -------------------------------------------------------------------------------- /pkgdown/favicon/favicon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bruigtp/flowchart/5f107b9abf49513405e4e8311ffe952f6a1a3763/pkgdown/favicon/favicon.ico -------------------------------------------------------------------------------- /pkgdown/favicon/site.webmanifest: -------------------------------------------------------------------------------- 1 | { 2 | "name": "", 3 | "short_name": "", 4 | "icons": [ 5 | { 6 | "src": "/web-app-manifest-192x192.png", 7 | "sizes": "192x192", 8 | "type": "image/png", 9 | "purpose": "maskable" 10 | }, 11 | { 12 | "src": "/web-app-manifest-512x512.png", 13 | "sizes": "512x512", 14 | "type": "image/png", 15 | "purpose": "maskable" 16 | } 17 | ], 18 | "theme_color": "#ffffff", 19 | "background_color": "#ffffff", 20 | "display": "standalone" 21 | } -------------------------------------------------------------------------------- /pkgdown/favicon/web-app-manifest-192x192.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bruigtp/flowchart/5f107b9abf49513405e4e8311ffe952f6a1a3763/pkgdown/favicon/web-app-manifest-192x192.png -------------------------------------------------------------------------------- /pkgdown/favicon/web-app-manifest-512x512.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bruigtp/flowchart/5f107b9abf49513405e4e8311ffe952f6a1a3763/pkgdown/favicon/web-app-manifest-512x512.png -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | # This file is part of the standard setup for testthat. 2 | # It is recommended that you do not modify it. 3 | # 4 | # Where should you do additional test configuration? 5 | # Learn more about the roles of various files in: 6 | # * https://r-pkgs.org/testing-design.html#sec-tests-files-overview 7 | # * https://testthat.r-lib.org/articles/special-files.html 8 | 9 | library(testthat) 10 | library(flowchart) 11 | 12 | test_check("flowchart") 13 | -------------------------------------------------------------------------------- /tests/testthat/Rplots.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bruigtp/flowchart/5f107b9abf49513405e4e8311ffe952f6a1a3763/tests/testthat/Rplots.pdf -------------------------------------------------------------------------------- /tests/testthat/_snaps/as_fc.md: -------------------------------------------------------------------------------- 1 | # errors with neither .data nor N 2 | 3 | Code 4 | as_fc() 5 | Condition 6 | Error in `as_fc()`: 7 | ! Either `.data` or `N` arguments must be specified. 8 | 9 | # errors with both .data and N 10 | 11 | Code 12 | as_fc(mtcars, N = 32) 13 | Condition 14 | Error in `as_fc()`: 15 | ! The `.data` and `N` arguments cannot be specified simultaneously. 16 | 17 | # errors when text_padding is zero 18 | 19 | Code 20 | as_fc(N = 100, text_padding = 0) 21 | Condition 22 | Error in `as_fc()`: 23 | ! Text padding cannot be equal to zero. 24 | 25 | # errors on invalid label type 26 | 27 | Code 28 | as_fc(N = 10, label = 1) 29 | Condition 30 | Error in `as_fc()`: 31 | ! The `label` and `text_pattern` must be either characters or expressions. 32 | 33 | # warns and returns NULL fc when hide = TRUE 34 | 35 | Code 36 | fc <- as_fc(N = 10, hide = TRUE) 37 | Condition 38 | Warning: 39 | `hide = TRUE` can only be combined with `fc_split()` 40 | 41 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/fc_draw.md: -------------------------------------------------------------------------------- 1 | # errors with invalid box_corners 2 | 3 | Code 4 | fc_draw(fc, box_corners = "invalid") 5 | Condition 6 | Error in `fc_draw()`: 7 | ! The `box_corners` argument must be "round" or "sharp". 8 | 9 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/fc_export.md: -------------------------------------------------------------------------------- 1 | # errors without draw parameters 2 | 3 | Code 4 | fc_export(fc, "test.png") 5 | Condition 6 | Error in `fc_export()`: 7 | ! Object must be created with `fc_draw()`. 8 | 9 | # errors with invalid format 10 | 11 | Code 12 | fc_export(fc, "test.invalid") 13 | Condition 14 | Error in `fc_export()`: 15 | ! Invalid `format` specified 16 | i Valid `format` choices are "png", "jpeg", "tiff", "bmp", "svg", and "pdf". 17 | 18 | # errors when format doesn't match extension 19 | 20 | Code 21 | fc_export(fc, "test.png", format = "pdf") 22 | Condition 23 | Error in `fc_export()`: 24 | ! `filename` extension and the specified `format` don't match. 25 | 26 | # errors with no extension and no format 27 | 28 | Code 29 | fc_export(fc, "test") 30 | Condition 31 | Error in `fc_export()`: 32 | ! File `filename` has no extension and format is `NULL`. 33 | 34 | # errors with invalid vector format units 35 | 36 | Code 37 | fc_export(fc, "test.pdf", units = "px") 38 | Condition 39 | Error in `fc_export()`: 40 | ! Invalid units for vector formats. Units must be "in", "cm", or "mm". 41 | 42 | # errors with invalid bitmap format units 43 | 44 | Code 45 | fc_export(fc, "test.png", units = "invalid") 46 | Condition 47 | Error in `fc_export()`: 48 | ! The `units` for bitmap formats must be "in", "cm", "mm", or "px". 49 | 50 | # warns about default dimensions for vector formats 51 | 52 | Code 53 | fc_export(fc, "test.pdf", units = "cm") 54 | Condition 55 | Warning: 56 | If `width` is missing for vector formats ("svg", "pdf"), default `width` is 6 inches. 57 | Warning: 58 | If `height` is missing for vector formats ("svg", "pdf"), default `height` is 6 inches. 59 | 60 | # warns about default dimensions for bitmap formats 61 | 62 | Code 63 | fc_export(fc, "test.png", units = "in") 64 | Condition 65 | Warning: 66 | If `width` is missing for bitmap formats, default `width` is 600 pixels. 67 | Warning: 68 | If `height` is missing for bitmap formats, default `height` is 600 pixels. 69 | Error: 70 | ! One or both dimensions exceed the maximum (50000px). 71 | - Use `options(ragg.max_dim = ...)` to change the max 72 | Warning: May cause the R session to crash 73 | 74 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/fc_filter.md: -------------------------------------------------------------------------------- 1 | # errors with neither filter nor N 2 | 3 | Code 4 | fc_filter(fc) 5 | Condition 6 | Error in `fc_filter()`: 7 | ! Either `filter` or `N` arguments must be specified. 8 | 9 | # errors with both filter and N 10 | 11 | Code 12 | fc_filter(fc, filter = TRUE, N = 5) 13 | Condition 14 | Error in `fc_filter()`: 15 | ! The `filter` and `N` arguments cannot be specified simultaneously. 16 | 17 | # errors when text_padding is zero 18 | 19 | Code 20 | fc_filter(fc, filter = TRUE, text_padding = 0) 21 | Condition 22 | Error in `fc_filter()`: 23 | ! Text padding cannot be equal to zero. 24 | 25 | --- 26 | 27 | Code 28 | fc_filter(fc, filter = TRUE, text_padding_exc = 0) 29 | Condition 30 | Error in `fc_filter()`: 31 | ! Text padding cannot be equal to zero. 32 | 33 | # errors when N is too large 34 | 35 | Code 36 | fc_filter(fc, N = 20) 37 | Condition 38 | Error in `fc_filter()`: 39 | ! The number of rows after the filter specified in `N` cannot exceed the original number of rows. 40 | 41 | # errors with invalid label type 42 | 43 | Code 44 | fc_filter(fc, filter = TRUE, label = 1) 45 | Condition 46 | Error in `fc_filter()`: 47 | ! The `label` and `text_pattern` must be either characters or expressions. 48 | 49 | # errors with invalid label_exc type 50 | 51 | Code 52 | fc_filter(fc, filter = TRUE, show_exc = TRUE, label_exc = 1) 53 | Condition 54 | Error in `fc_filter()`: 55 | ! The `label_exc` and `text_pattern_exc` must be either characters or expressions. 56 | 57 | # errors when sel_group used without groups 58 | 59 | Code 60 | fc_filter(fc, filter = TRUE, sel_group = "A") 61 | Condition 62 | Error in `fc_filter()`: 63 | ! Cannot supply `sel_group` because no groups exist in the flowchart yet, as no previous split has been performed. 64 | 65 | # errors informatively with nonexistent group 66 | 67 | Code 68 | fc_filter(fc, filter = TRUE, sel_group = "C") 69 | Condition 70 | Error in `fc_filter()`: 71 | ! Cannot supply `sel_group` because no groups exist in the flowchart yet, as no previous split has been performed. 72 | 73 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/fc_split.md: -------------------------------------------------------------------------------- 1 | # errors with neither var nor N 2 | 3 | Code 4 | fc_split(fc) 5 | Condition 6 | Error in `fc_split()`: 7 | ! A `var` or `N` argument must be specified. 8 | 9 | # errors with both var and N 10 | 11 | Code 12 | fc_split(fc, var = "group", N = 5) 13 | Condition 14 | Error in `fc_split()`: 15 | ! Arguments `var` and `N` cannot be specified simultaneously. 16 | 17 | # errors when text_padding is zero 18 | 19 | Code 20 | fc_split(fc, N = c(5, 5), text_padding = 0) 21 | Condition 22 | Error in `fc_split()`: 23 | ! Text padding cannot be equal to zero. 24 | 25 | # errors with invalid label type 26 | 27 | Code 28 | fc_split(fc, N = c(5, 5), label = 1) 29 | Condition 30 | Error in `fc_split()`: 31 | ! The `label` and `text_pattern` must be either characters or expressions. 32 | 33 | # errors when sel_group used without previous split 34 | 35 | Code 36 | fc_split(fc, N = c(5, 5), sel_group = "A") 37 | Condition 38 | Error in `fc_split()`: 39 | ! The `sel_group` argument can't be used because no groups exist in the flowchart, as no previous split has been performed. 40 | 41 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/fc_view.md: -------------------------------------------------------------------------------- 1 | # errors with invalid what argument 2 | 3 | Code 4 | fc_view(fc, "invalid") 5 | Condition 6 | Error in `fc_view()`: 7 | ! `what` argument must be one of "data" or "fc". 8 | 9 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/utils.md: -------------------------------------------------------------------------------- 1 | # warns when big.mark equals OutDec 2 | 3 | Code 4 | update_numbers(fc, big.mark = ".") 5 | Condition 6 | Warning: 7 | You have set `big.mark` equal to your environment's `OutDec` ('.') - it can be confusing if your flowchart uses the same mark for both. 8 | i Consider an alternative decimal mark. 9 | > To change the decimal mark, run: `options(OutDec = "")` 10 | Output 11 | $data 12 | # A tibble: 1,000 x 1 13 | id 14 | 15 | 1 1 16 | 2 2 17 | 3 3 18 | 4 4 19 | 5 5 20 | 6 6 21 | 7 7 22 | 8 8 23 | 9 9 24 | 10 10 25 | # i 990 more rows 26 | 27 | $fc 28 | # A tibble: 1 x 20 29 | id x y n N perc text type group just text_color text_fs 30 | 31 | 1 1 0.5 0.5 1000 1000 100 "Ini~ init NA cent~ black 8 32 | # i 8 more variables: text_fface , text_ffamily , text_padding , 33 | # bg_fill , border_color , width , height , end 34 | 35 | attr(,"class") 36 | [1] "fc" 37 | 38 | -------------------------------------------------------------------------------- /tests/testthat/test-as_fc.R: -------------------------------------------------------------------------------- 1 | 2 | test_that("errors with neither .data nor N", { 3 | expect_snapshot(as_fc(), error = TRUE) 4 | }) 5 | 6 | test_that("errors with both .data and N", { 7 | expect_snapshot(as_fc(mtcars, N = 32), error = TRUE) 8 | }) 9 | 10 | test_that("errors when text_padding is zero", { 11 | expect_snapshot(as_fc(N = 100, text_padding = 0), error = TRUE) 12 | }) 13 | 14 | test_that("initializes flowchart from data frame", { 15 | df <- data.frame(x = 1:3) 16 | fc <- as_fc(df) 17 | expect_s3_class(fc, "fc") 18 | expect_equal(fc$data, dplyr::ungroup(df)) 19 | expect_equal(nrow(fc$fc), 1) 20 | expect_equal(fc$fc$N, 3) 21 | expect_equal(fc$fc$text, "Initial dataframe\n3") 22 | }) 23 | 24 | test_that("initializes flowchart from N", { 25 | fc <- as_fc(N = 10) 26 | expect_s3_class(fc, "fc") 27 | expect_equal(fc$data, tibble::tibble(id = 1:10)) 28 | expect_equal(nrow(fc$fc), 1) 29 | expect_equal(fc$fc$N, 10) 30 | expect_equal(fc$fc$text, "Initial dataframe\n10") 31 | }) 32 | 33 | test_that("accepts custom label and text pattern", { 34 | fc <- as_fc(N = 10, label = "Test", text_pattern = "{label}: {N} total") 35 | expect_equal(fc$fc$text, "Test: 10 total") 36 | }) 37 | 38 | test_that("accepts expression label", { 39 | fc <- as_fc(N = 10, label = expression(alpha)) 40 | expect_type(fc$fc$text[[1]], "language") 41 | }) 42 | 43 | test_that("errors on invalid label type", { 44 | expect_snapshot(as_fc(N = 10, label = 1), error = TRUE) 45 | }) 46 | 47 | test_that("warns and returns NULL fc when hide = TRUE", { 48 | expect_snapshot(fc <- as_fc(N = 10, hide = TRUE)) 49 | expect_null(fc$fc) 50 | expect_equal(fc$data, tibble::tibble(id = 1:10)) 51 | }) 52 | 53 | test_that("preserves styling parameters", { 54 | fc <- as_fc(N = 10, 55 | text_color = "red", 56 | text_fs = 12, 57 | text_fface = 2, 58 | text_ffamily = "serif", 59 | bg_fill = "yellow", 60 | border_color = "blue") 61 | expect_equal(fc$fc$text_color, "red") 62 | expect_equal(fc$fc$text_fs, 12) 63 | expect_equal(fc$fc$text_fface, 2) 64 | expect_equal(fc$fc$text_ffamily, "serif") 65 | expect_equal(fc$fc$bg_fill, "yellow") 66 | expect_equal(fc$fc$border_color, "blue") 67 | }) 68 | -------------------------------------------------------------------------------- /tests/testthat/test-fc_draw.R: -------------------------------------------------------------------------------- 1 | 2 | test_that("errors with invalid box_corners", { 3 | fc <- as_fc(N = 10) 4 | expect_snapshot(fc_draw(fc, box_corners = "invalid"), error = TRUE) 5 | }) 6 | 7 | test_that("accepts valid box_corners values", { 8 | fc <- as_fc(N = 10) 9 | expect_no_error(fc_draw(fc, box_corners = "round")) 10 | expect_no_error(fc_draw(fc, box_corners = "sharp")) 11 | }) 12 | 13 | test_that("sets arrow parameters in attributes", { 14 | fc <- as_fc(N = 10) 15 | result <- fc_draw(fc) 16 | attrs <- attr(result$fc, "draw") 17 | expect_equal(attrs$arrow_angle, 30) 18 | expect_equal(attrs$arrow_ends, "last") 19 | expect_equal(attrs$arrow_type, "closed") 20 | expect_s3_class(attrs$arrow_length, "unit") 21 | }) 22 | 23 | test_that("coerces tibble fc to list", { 24 | fc <- as_fc(N = 10) 25 | expect_type(fc$fc, "list") 26 | result <- fc_draw(fc) 27 | expect_type(result$fc, "list") 28 | }) 29 | -------------------------------------------------------------------------------- /tests/testthat/test-fc_export.R: -------------------------------------------------------------------------------- 1 | 2 | test_that("errors without draw parameters", { 3 | fc <- as_fc(N = 10) 4 | expect_snapshot(fc_export(fc, "test.png"), error = TRUE) 5 | }) 6 | 7 | test_that("errors with invalid format", { 8 | fc <- as_fc(N = 10) |> fc_draw() 9 | expect_snapshot(fc_export(fc, "test.invalid"), error = TRUE) 10 | }) 11 | 12 | test_that("errors when format doesn't match extension", { 13 | fc <- as_fc(N = 10) |> fc_draw() 14 | expect_snapshot(fc_export(fc, "test.png", format = "pdf"), error = TRUE) 15 | }) 16 | 17 | test_that("errors with no extension and no format", { 18 | fc <- as_fc(N = 10) |> fc_draw() 19 | expect_snapshot(fc_export(fc, "test"), error = TRUE) 20 | }) 21 | 22 | test_that("errors with invalid vector format units", { 23 | fc <- as_fc(N = 10) |> fc_draw() 24 | expect_snapshot(fc_export(fc, "test.pdf", units = "px"), error = TRUE) 25 | }) 26 | 27 | test_that("errors with invalid bitmap format units", { 28 | fc <- as_fc(N = 10) |> fc_draw() 29 | expect_snapshot(fc_export(fc, "test.png", units = "invalid"), error = TRUE) 30 | }) 31 | 32 | test_that("warns about default dimensions for vector formats", { 33 | fc <- as_fc(N = 10) |> fc_draw() 34 | expect_snapshot(fc_export(fc, "test.pdf", units = "cm")) 35 | }) 36 | 37 | test_that("warns about default dimensions for bitmap formats", { 38 | fc <- as_fc(N = 10) |> fc_draw() 39 | expect_snapshot(fc_export(fc, "test.png", units = "in"), error = TRUE) 40 | }) 41 | 42 | test_that("adds extension when format specified without one", { 43 | fc <- as_fc(N = 10) |> fc_draw() 44 | tempdir <- tempdir() 45 | filename <- file.path(tempdir, "test") 46 | expect_no_error(fc_export(fc, filename, format = "png")) 47 | expect_true(file.exists(file.path(tempdir, "test.png"))) 48 | }) 49 | 50 | test_that("uses path when specified", { 51 | fc <- as_fc(N = 10) |> fc_draw() 52 | tempdir <- tempdir() 53 | expect_no_error(fc_export(fc, "test.png", path = tempdir)) 54 | expect_true(file.exists(file.path(tempdir, "test.png"))) 55 | }) 56 | -------------------------------------------------------------------------------- /tests/testthat/test-fc_filter.R: -------------------------------------------------------------------------------- 1 | 2 | test_that("errors with neither filter nor N", { 3 | fc <- as_fc(N = 10) 4 | expect_snapshot(fc_filter(fc), error = TRUE) 5 | }) 6 | 7 | test_that("errors with both filter and N", { 8 | fc <- as_fc(N = 10) 9 | expect_snapshot(fc_filter(fc, filter = TRUE, N = 5), error = TRUE) 10 | }) 11 | 12 | test_that("errors when text_padding is zero", { 13 | fc <- as_fc(N = 10) 14 | expect_snapshot(fc_filter(fc, filter = TRUE, text_padding = 0), error = TRUE) 15 | expect_snapshot(fc_filter(fc, filter = TRUE, text_padding_exc = 0), error = TRUE) 16 | }) 17 | 18 | test_that("errors when N is too large", { 19 | fc <- as_fc(N = 10) 20 | expect_snapshot(fc_filter(fc, N = 20), error = TRUE) 21 | }) 22 | 23 | test_that("errors with invalid label type", { 24 | fc <- as_fc(N = 10) 25 | expect_snapshot(fc_filter(fc, filter = TRUE, label = 1), error = TRUE) 26 | }) 27 | 28 | test_that("errors with invalid label_exc type", { 29 | fc <- as_fc(N = 10) 30 | expect_snapshot(fc_filter(fc, filter = TRUE, show_exc = TRUE, label_exc = 1), error = TRUE) 31 | }) 32 | 33 | test_that("errors when sel_group used without groups", { 34 | fc <- as_fc(N = 10) 35 | expect_snapshot(fc_filter(fc, filter = TRUE, sel_group = "A"), error = TRUE) 36 | }) 37 | 38 | test_that("accepts valid filter expression", { 39 | df <- data.frame(x = 1:10, y = c(rep(TRUE, 5), rep(FALSE, 5))) 40 | fc <- as_fc(df) 41 | result <- fc_filter(fc, filter = y) 42 | expect_equal(nrow(result$data), 5) 43 | expect_equal(result$fc$n[2], 5) 44 | }) 45 | 46 | test_that("handles show_exc parameter", { 47 | df <- data.frame(x = 1:10, y = c(rep(TRUE, 5), rep(FALSE, 5))) 48 | fc <- as_fc(df) 49 | result <- fc_filter(fc, filter = y, show_exc = TRUE) 50 | exc_rows <- result$fc |> dplyr::filter(type == "exclude") 51 | expect_equal(nrow(exc_rows), 1) 52 | expect_equal(exc_rows$n, 5) 53 | }) 54 | 55 | test_that("preserves styling parameters", { 56 | fc <- as_fc(N = 10) 57 | result <- fc_filter(fc, N = 5, 58 | text_color = "red", 59 | text_fs = 12, 60 | bg_fill = "yellow", 61 | border_color = "blue" 62 | ) 63 | new_box <- result$fc |> dplyr::filter(type == "filter") 64 | expect_equal(new_box$text_color, "red") 65 | expect_equal(new_box$text_fs, 12) 66 | expect_equal(new_box$bg_fill, "yellow") 67 | expect_equal(new_box$border_color, "blue") 68 | }) 69 | 70 | test_that("errors informatively with nonexistent group", { 71 | fc <- as_fc(N = 10) 72 | x <- tibble::tibble( 73 | group = c("A", "B") 74 | ) 75 | attr(fc$fc, "group") <- x$group 76 | expect_snapshot( 77 | fc_filter(fc, filter = TRUE, sel_group = "C"), 78 | error = TRUE 79 | ) 80 | }) 81 | -------------------------------------------------------------------------------- /tests/testthat/test-fc_merge.R: -------------------------------------------------------------------------------- 1 | 2 | test_that("merges multiple flowcharts", { 3 | fc1 <- as_fc(N = 10) 4 | fc2 <- as_fc(N = 15) 5 | result <- fc_merge(list(fc1, fc2)) 6 | expect_s3_class(result, "fc") 7 | expect_equal(length(result$data), 2) 8 | expect_equal(length(result$fc), 2) 9 | expect_equal(result$data[[1]], fc1$data) 10 | expect_equal(result$data[[2]], fc2$data) 11 | }) 12 | 13 | test_that("updates x coordinates for merged charts", { 14 | fc1 <- as_fc(N = 10) 15 | fc2 <- as_fc(N = 15) 16 | result <- fc_merge(list(fc1, fc2)) 17 | x_coords1 <- result$fc[[1]]$x 18 | x_coords2 <- result$fc[[2]]$x 19 | expect_true(all(x_coords1 != x_coords2)) 20 | }) 21 | 22 | test_that("preserves input data and structure", { 23 | fc1 <- as_fc(N = 10) 24 | fc2 <- as_fc(N = 15) 25 | result <- fc_merge(list(fc1, fc2)) 26 | expect_equal(nrow(result$fc[[1]]), nrow(fc1$fc)) 27 | expect_equal(nrow(result$fc[[2]]), nrow(fc2$fc)) 28 | expect_named(result, c("id", "data", "fc")) 29 | }) 30 | 31 | test_that("handles single flowchart correctly", { 32 | fc1 <- as_fc(N = 10) 33 | result <- fc_merge(list(fc1)) 34 | expect_equal(length(result$data), 1) 35 | expect_equal(length(result$fc), 1) 36 | expect_equal(result$data[[1]], fc1$data) 37 | }) 38 | 39 | test_that("preserves attributes and classes", { 40 | fc1 <- as_fc(N = 10) 41 | fc2 <- as_fc(N = 15) 42 | result <- fc_merge(list(fc1, fc2)) 43 | expect_s3_class(result, "fc") 44 | expect_true(rlang::is_list(result)) 45 | expect_true(tibble::is_tibble(result$fc[[1]])) 46 | expect_true(tibble::is_tibble(result$fc[[2]])) 47 | }) 48 | -------------------------------------------------------------------------------- /tests/testthat/test-fc_modify.R: -------------------------------------------------------------------------------- 1 | 2 | test_that("modifies flowchart with function", { 3 | fc <- as_fc(N = 10) 4 | result <- fc_modify(fc, function(x) dplyr::mutate(x, text_fs = 12)) 5 | expect_equal(result$fc$text_fs, 12) 6 | expect_s3_class(result, "fc") 7 | }) 8 | 9 | test_that("modifies flowchart with formula", { 10 | fc <- as_fc(N = 10) 11 | result <- fc_modify(fc, ~dplyr::mutate(.x, text_fs = 12)) 12 | expect_equal(result$fc$text_fs, 12) 13 | expect_s3_class(result, "fc") 14 | }) 15 | 16 | test_that("preserves other attributes when modifying", { 17 | fc <- as_fc(N = 10) 18 | original_n <- fc$fc$n 19 | result <- fc_modify(fc, ~dplyr::mutate(.x, text_fs = 12)) 20 | expect_equal(result$fc$n, original_n) 21 | expect_equal(result$data, fc$data) 22 | }) 23 | 24 | test_that("handles additional arguments", { 25 | fc <- as_fc(N = 10) 26 | modify_fn <- function(x, new_size) dplyr::mutate(x, text_fs = new_size) 27 | result <- fc_modify(fc, modify_fn, new_size = 14) 28 | expect_equal(result$fc$text_fs, 14) 29 | }) 30 | 31 | test_that("works with tibble and list fc components", { 32 | fc1 <- as_fc(N = 10) 33 | fc2 <- structure( 34 | list( 35 | data = fc1$data, 36 | fc = list(fc1$fc) 37 | ), 38 | class = "fc" 39 | ) 40 | 41 | result1 <- fc_modify(fc1, ~dplyr::mutate(.x, text_fs = 12)) 42 | result2 <- fc_modify(fc2, ~dplyr::mutate(.x, text_fs = 12)) 43 | 44 | expect_true(tibble::is_tibble(result1$fc)) 45 | expect_type(result2$fc, "list") 46 | }) 47 | -------------------------------------------------------------------------------- /tests/testthat/test-fc_split.R: -------------------------------------------------------------------------------- 1 | 2 | test_that("errors with neither var nor N", { 3 | fc <- as_fc(N = 10) 4 | expect_snapshot(fc_split(fc), error = TRUE) 5 | }) 6 | 7 | test_that("errors with both var and N", { 8 | fc <- as_fc(N = 10) 9 | expect_snapshot(fc_split(fc, var = "group", N = 5), error = TRUE) 10 | }) 11 | 12 | test_that("errors when text_padding is zero", { 13 | fc <- as_fc(N = 10) 14 | expect_snapshot(fc_split(fc, N = c(5,5), text_padding = 0), error = TRUE) 15 | }) 16 | 17 | test_that("errors with invalid label type", { 18 | fc <- as_fc(N = 10) 19 | expect_snapshot(fc_split(fc, N = c(5,5), label = 1), error = TRUE) 20 | }) 21 | 22 | test_that("errors when sel_group used without previous split", { 23 | fc <- as_fc(N = 10) 24 | expect_snapshot(fc_split(fc, N = c(5,5), sel_group = "A"), error = TRUE) 25 | }) 26 | 27 | test_that("handles numeric splits correctly", { 28 | fc <- as_fc(N = 10) 29 | result <- fc_split(fc, N = c(5,5)) 30 | expect_equal(nrow(result$fc), 3) # Initial box + 2 split boxes 31 | expect_equal(unique(result$fc$type[2:3]), "split") 32 | }) 33 | 34 | test_that("handles factor splits correctly", { 35 | df <- data.frame(group = factor(rep(c("A","B"), each = 5))) 36 | fc <- as_fc(df) 37 | result <- fc_split(fc, var = group) 38 | expect_equal(nrow(result$fc), 3) # Initial box + 2 split boxes 39 | expect_equal(sum(result$fc$n[2:3]), 10) 40 | }) 41 | 42 | test_that("handles custom labels", { 43 | fc <- as_fc(N = 10) 44 | result <- fc_split(fc, N = c(5,5), label = c("Group A", "Group B")) 45 | expect_match(result$fc$text[2], "Group A") 46 | expect_match(result$fc$text[3], "Group B") 47 | }) 48 | 49 | test_that("handles title correctly", { 50 | fc <- as_fc(N = 10) 51 | result <- fc_split(fc, N = c(5,5), title = "Test Title") 52 | expect_equal(sum(result$fc$type == "title_split"), 1) 53 | expect_equal(result$fc$text[result$fc$type == "title_split"], "Test Title") 54 | }) 55 | 56 | test_that("preserves styling parameters", { 57 | fc <- as_fc(N = 10) 58 | result <- fc_split(fc, N = c(5,5), 59 | text_color = "red", 60 | text_fs = 12, 61 | bg_fill = "yellow", 62 | border_color = "blue") 63 | new_boxes <- result$fc |> dplyr::filter(type == "split") 64 | expect_equal(unique(new_boxes$text_color), "red") 65 | expect_equal(unique(new_boxes$text_fs), 12) 66 | expect_equal(unique(new_boxes$bg_fill), "yellow") 67 | expect_equal(unique(new_boxes$border_color), "blue") 68 | }) 69 | -------------------------------------------------------------------------------- /tests/testthat/test-fc_stack.R: -------------------------------------------------------------------------------- 1 | 2 | test_that("stacks multiple flowcharts", { 3 | fc1 <- as_fc(N = 10) 4 | fc2 <- as_fc(N = 15) 5 | result <- fc_stack(list(fc1, fc2)) 6 | expect_s3_class(result, "fc") 7 | expect_equal(length(result$data), 2) 8 | expect_equal(length(result$fc), 2) 9 | expect_equal(result$data[[1]], fc1$data) 10 | expect_equal(result$data[[2]], fc2$data) 11 | }) 12 | 13 | test_that("updates y coordinates when stacking", { 14 | fc1 <- as_fc(N = 10) 15 | fc2 <- as_fc(N = 15) 16 | result <- fc_stack(list(fc1, fc2)) 17 | y_coords1 <- result$fc[[1]]$y 18 | y_coords2 <- result$fc[[2]]$y 19 | expect_true(all(y_coords1 != y_coords2)) 20 | }) 21 | 22 | test_that("handles unite = TRUE with compatible charts", { 23 | fc1 <- as_fc(N = 10) 24 | fc2 <- as_fc(N = 10) 25 | result <- fc_stack(list(fc1, fc2), unite = TRUE) 26 | expect_type(result$fc, "list") 27 | expect_true("fc" %in% names(result)) 28 | expect_equal(result$fc$type[2], "stack") 29 | }) 30 | 31 | test_that("successfully handles stacking when unite = TRUE", { 32 | fc1 <- as_fc(N = 10) |> fc_split(N = c(5, 5)) 33 | fc2 <- as_fc(N = 10) |> fc_split(N = c(3, 3, 4)) 34 | 35 | result <- fc_stack(list(fc1, fc2), unite = TRUE) 36 | 37 | expect_s3_class(result, "fc") 38 | }) 39 | 40 | test_that("preserves original data in stacked charts", { 41 | fc1 <- as_fc(N = 10) 42 | fc2 <- as_fc(N = 15) 43 | result <- fc_stack(list(fc1, fc2)) 44 | expect_equal(result$data[[1]], fc1$data) 45 | expect_equal(result$data[[2]], fc2$data) 46 | }) 47 | 48 | 49 | -------------------------------------------------------------------------------- /tests/testthat/test-fc_theme.R: -------------------------------------------------------------------------------- 1 | test_that("modifies flowchart with new parameter", { 2 | fc <- as_fc(N = 10) 3 | result <- fc_theme(fc, text_fs = 12) 4 | expect_equal(result$fc$text_fs, 12) 5 | expect_s3_class(result, "fc") 6 | }) 7 | 8 | test_that("preserves other attributes when modifying", { 9 | fc <- as_fc(N = 10) 10 | original_n <- fc$fc$n 11 | result <- fc_theme(fc, text_fs = 12) 12 | expect_equal(result$fc$n, original_n) 13 | expect_equal(result$data, fc$data) 14 | }) 15 | 16 | test_that("modifies only excluded boxes", { 17 | fc <- as_fc(N = 10) |> 18 | fc_filter(N = 2, show_exc = TRUE) 19 | result <- fc_theme(fc, text_fs_exc = 12) 20 | expect_equal(result$fc$text_fs[result$fc$type == "exclude"], 12) 21 | expect_equal(result$fc$text_fs[result$fc$type != "exclude"], c(8, 8)) 22 | expect_s3_class(result, "fc") 23 | }) 24 | 25 | test_that("modifies only title boxes", { 26 | fc <- as_fc(N = 10) |> 27 | fc_split(N = c(5, 5), title = "Group") 28 | result <- fc_theme(fc, text_fs_title = 12) 29 | expect_equal(result$fc$text_fs[result$fc$type == "title_split"], 12) 30 | expect_equal(result$fc$text_fs[result$fc$type != "title_split"], c(8, 8, 8)) 31 | expect_s3_class(result, "fc") 32 | }) 33 | 34 | test_that("don't modify flowchart", { 35 | fc <- as_fc(N = 10) 36 | result <- suppressWarnings(fc_theme(fc)) 37 | expect_equal(fc$fc, result$fc) 38 | expect_s3_class(result, "fc") 39 | }) 40 | -------------------------------------------------------------------------------- /tests/testthat/test-fc_view.R: -------------------------------------------------------------------------------- 1 | 2 | test_that("errors with invalid what argument", { 3 | fc <- as_fc(N = 10) 4 | expect_snapshot(fc_view(fc, "invalid"), error = TRUE) 5 | }) 6 | 7 | test_that("returns data component correctly", { 8 | fc <- as_fc(N = 10) 9 | expect_equal(fc_view(fc, "data"), fc$data) 10 | expect_equal(nrow(fc_view(fc, "data")), 10) 11 | }) 12 | 13 | test_that("returns fc component correctly", { 14 | fc <- as_fc(N = 10) 15 | expect_equal(fc_view(fc, "fc"), fc$fc) 16 | expect_true(tibble::is_tibble(fc_view(fc, "fc"))) 17 | }) 18 | 19 | test_that("preserves tibble structure in output", { 20 | df <- tibble::tibble(x = 1:3, y = letters[1:3]) 21 | fc <- as_fc(df) 22 | expect_true(tibble::is_tibble(fc_view(fc, "data"))) 23 | expect_true(tibble::is_tibble(fc_view(fc, "fc"))) 24 | }) 25 | 26 | test_that("accepts valid what arguments", { 27 | fc <- as_fc(N = 10) 28 | expect_no_error(fc_view(fc, "data")) 29 | expect_no_error(fc_view(fc, "fc")) 30 | }) 31 | 32 | test_that("returns correct component type", { 33 | fc <- as_fc(N = 10) 34 | expect_type(fc_view(fc, "data"), "list") # tibble is a list 35 | expect_s3_class(fc_view(fc, "data"), "tbl_df") 36 | expect_type(fc_view(fc, "fc"), "list") 37 | expect_s3_class(fc_view(fc, "fc"), "tbl_df") 38 | }) 39 | -------------------------------------------------------------------------------- /tests/testthat/test-utils.R: -------------------------------------------------------------------------------- 1 | 2 | test_that("handles NULL expression", { 3 | row <- list(n = 10, N = 100) 4 | expect_null(replace_num_in_expr(NULL, row, ",")) 5 | }) 6 | 7 | test_that("formats numeric values", { 8 | row <- list(n = 1000, N = 2000) 9 | expect_equal(replace_num_in_expr(1000, row, ","), "1,000") 10 | expect_equal(replace_num_in_expr(2000, row, ","), "2,000") 11 | }) 12 | 13 | test_that("formats numbers in character strings", { 14 | row <- list(n = 1000, N = 2000) 15 | expect_equal( 16 | replace_num_in_expr("Total n = 1000 out of 2000", row, ","), 17 | "Total n = 1,000 out of 2,000" 18 | ) 19 | }) 20 | 21 | test_that("preserves non-matching numbers in strings", { 22 | row <- list(n = 1000, N = 2000) 23 | expect_equal( 24 | replace_num_in_expr("Other numbers 3000 and 4000", row, ","), 25 | "Other numbers 3000 and 4000" 26 | ) 27 | }) 28 | 29 | test_that("handles expression objects", { 30 | row <- list(n = 1000, N = 2000) 31 | expr <- expression(paste("n =", 1000)) 32 | result <- replace_num_in_expr(expr, row, ",") 33 | expect_type(result, "expression") 34 | }) 35 | 36 | test_that("handles language objects", { 37 | row <- list(n = 1000, N = 2000) 38 | call <- quote(paste("n =", 1000)) 39 | result <- replace_num_in_expr(call, row, ",") 40 | expect_type(result, "language") 41 | }) 42 | 43 | test_that("handles NA values in row", { 44 | row <- list(n = NA, N = 1000) 45 | expect_equal(replace_num_in_expr("Text 1000", row, ","), "Text 1,000") 46 | }) 47 | 48 | test_that("warns when big.mark equals OutDec", { 49 | fc <- as_fc(N = 1000) 50 | withr::local_options(OutDec = ".") 51 | expect_snapshot(update_numbers(fc, big.mark = ".")) 52 | }) 53 | 54 | test_that("formats numbers in tibble fc", { 55 | fc <- as_fc(N = 1000) 56 | result <- update_numbers(fc, big.mark = ",") 57 | expect_match(result$fc$text, "1,000") 58 | }) 59 | 60 | test_that("formats numbers in list fc", { 61 | fc <- as_fc(N = 1000) 62 | fc$fc <- list(fc$fc) 63 | result <- update_numbers(fc, big.mark = ",") 64 | expect_match(result$fc[[1]]$text, "1,000") 65 | }) 66 | 67 | test_that("handles missing values correctly", { 68 | fc <- as_fc(N = 10) 69 | fc$fc$n <- NA 70 | result <- update_numbers(fc, big.mark = ",") 71 | expect_equal(result$fc$text, fc$fc$text) 72 | }) 73 | 74 | test_that("preserves expression text", { 75 | fc <- as_fc(N = 1000, label = expression(alpha)) 76 | result <- update_numbers(fc, big.mark = ",") 77 | expect_type(result$fc$text[[1]], "language") 78 | }) 79 | 80 | test_that("handles character list text", { 81 | fc <- as_fc(N = 1000) 82 | fc$fc$text <- list("Text 1000") 83 | result <- update_numbers(fc, big.mark = ",") 84 | expect_equal(result$fc$text[[1]], "Text 1,000") 85 | }) 86 | 87 | test_that("preserves other object attributes", { 88 | fc <- as_fc(N = 1000) 89 | original_attrs <- attributes(fc) 90 | result <- update_numbers(fc, big.mark = ",") 91 | expect_equal(attributes(result)[names(original_attrs)], original_attrs) 92 | }) 93 | -------------------------------------------------------------------------------- /tests/testthat/test.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bruigtp/flowchart/5f107b9abf49513405e4e8311ffe952f6a1a3763/tests/testthat/test.pdf -------------------------------------------------------------------------------- /tests/testthat/testthat-problems.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bruigtp/flowchart/5f107b9abf49513405e4e8311ffe952f6a1a3763/tests/testthat/testthat-problems.rds -------------------------------------------------------------------------------- /vignettes/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | *.R 3 | -------------------------------------------------------------------------------- /vignettes/articles/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | *.R 3 | -------------------------------------------------------------------------------- /vignettes/articles/combine-flowcharts.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Combine Flowcharts" 3 | output: 4 | rmarkdown::html_vignette: 5 | toc: true 6 | toc_depth: 5 7 | number_sections: true 8 | vignette: > 9 | %\VignetteIndexEntry{Combine Flowcharts} 10 | %\VignetteEncoding{UTF-8} 11 | %\VignetteEngine{knitr::rmarkdown} 12 | editor_options: 13 | chunk_output_type: console 14 | --- 15 | 16 | ```{r message=FALSE, warning=FALSE, include=FALSE} 17 | library(flowchart) 18 | library(dplyr) 19 | library(tidyr) 20 | library(purrr) 21 | library(stringr) 22 | library(tibble) 23 | ``` 24 | 25 | `fc_merge()` and `fc_stack()` allow you to combine different `flowchart`s horizontally or vertically. This is very useful when you need to combine `flowchart`s generated from different `data.frame`s, as shown here. 26 | 27 | # Merge 28 | 29 | We can combine different `flowchart`s horizontally using `fc_merge()`. For example, we might want to represent the flow of patients included in the ITT population with the flow of patients included in the PP population. 30 | 31 | ```{r fig.width = 8} 32 | # Create first flowchart for ITT 33 | fc1 <- safo |> 34 | as_fc(label = "Patients assessed for eligibility") |> 35 | fc_filter(itt == "Yes", label = "Intention to treat (ITT)") 36 | 37 | fc_draw(fc1) 38 | 39 | # Create second flowchart for visits 40 | fc2 <- safo |> 41 | as_fc(label = "Patients assessed for eligibility") |> 42 | fc_filter(pp == "Yes", label = "Per protocol (PP)") 43 | 44 | fc_draw(fc2) 45 | 46 | list(fc1, fc2) |> 47 | fc_merge() |> 48 | fc_draw() 49 | ``` 50 | 51 | # Stack 52 | 53 | We can combine different `flowchart`s vertically using `fc_stack()`. For example, we can combine the same two `flowchart`s vertically instead of horizontally. 54 | 55 | ```{r warning = FALSE, fig.width = 6, fig.height = 5} 56 | list(fc1, fc2) |> 57 | fc_stack() |> 58 | fc_draw() 59 | ``` 60 | 61 | We can use the argument `unite = TRUE` to connect two stacked `flowchart`s. Two flowcharts can be merged only if they have the same boxes at the beginning and at the end, or if one of the flowcharts has one box at the beginning or at the end. For example: 62 | 63 | ```{r warning=FALSE, fig.width = 6, fig.height = 5} 64 | fc1 <- safo |> 65 | as_fc(label = "Patients assessed for eligibility") |> 66 | fc_filter(itt == "Yes", label = "Intention to treat (ITT)") |> 67 | fc_split(group) 68 | 69 | fc2 <- safo |> 70 | dplyr::filter(pp == "Yes") |> 71 | as_fc(label = "Per protocol (PP)") 72 | 73 | list(fc1, fc2) |> 74 | fc_stack(unite = TRUE) |> 75 | fc_draw() 76 | ``` 77 | 78 | ```{r warning=FALSE, fig.width = 6, fig.height = 5} 79 | fc1 <- safo |> 80 | as_fc(label = "Patients assessed for eligibility") |> 81 | fc_filter(itt == "Yes", label = "Intention to treat (ITT)") 82 | 83 | fc2 <- safo |> 84 | dplyr::filter(pp == "Yes") |> 85 | as_fc(hide = TRUE) |> 86 | fc_split(group, label = c("cloxacillin plus fosfomycin (PP)", "cloxacillin alone (PP)"), text_pattern = "{label}\n{n}") 87 | 88 | list(fc1, fc2) |> 89 | fc_stack(unite = TRUE) |> 90 | fc_draw() 91 | ``` 92 | 93 | ```{r warning=FALSE, fig.width = 6, fig.height = 5} 94 | fc1 <- safo |> 95 | as_fc(label = "Patients assessed for eligibility") |> 96 | fc_filter(itt == "Yes", label = "Intention to treat (ITT)") |> 97 | fc_split(group, label = c("cloxacillin plus fosfomycin (ITT)", "cloxacillin alone (ITT)")) 98 | 99 | fc2 <- safo |> 100 | dplyr::filter(pp == "Yes") |> 101 | as_fc(hide = TRUE) |> 102 | fc_split(group, label = c("cloxacillin plus fosfomycin (PP)", "cloxacillin alone (PP)"), text_pattern = "{label}\n{n}") 103 | 104 | list(fc1, fc2) |> 105 | fc_stack(unite = TRUE) |> 106 | fc_draw() 107 | ``` 108 | -------------------------------------------------------------------------------- /vignettes/articles/example-gallery.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Flowchart Example Gallery" 3 | output: 4 | rmarkdown::html_vignette: 5 | toc: true 6 | toc_depth: 5 7 | number_sections: true 8 | vignette: > 9 | %\VignetteIndexEntry{Flowchart Example Gallery} 10 | %\VignetteEncoding{UTF-8} 11 | %\VignetteEngine{knitr::rmarkdown} 12 | editor_options: 13 | chunk_output_type: console 14 | --- 15 | 16 | ```{r message=FALSE, warning=FALSE, include=FALSE} 17 | library(flowchart) 18 | library(dplyr) 19 | library(tidyr) 20 | library(purrr) 21 | library(stringr) 22 | library(tibble) 23 | ``` 24 | 25 | # Example 1 26 | 27 | In this example, we will try to create a `flowchart` for the complete flow of patients in the SAFO study: 28 | 29 | ```{r warning = FALSE, fig.width = 7, fig.height = 7} 30 | safo |> 31 | as_fc(label = "Patients assessed for eligibility") |> 32 | fc_filter(!is.na(group), label = "Randomized", show_exc = TRUE) |> 33 | fc_split(group) |> 34 | fc_filter(itt == "Yes", label = "Included in ITT") |> 35 | fc_filter(pp == "Yes", label = "Included in PP") |> 36 | fc_draw() 37 | ``` 38 | 39 | # Example 2 40 | 41 | In this example, we will try to exactly reproduce the original `flowchart` of the SAFO study published in Nature Medicine: [SAFO `flowchart`](https://www.nature.com/articles/s41591-023-02569-0/figures/1). 42 | 43 | First, we need to do some pre-processing to reproduce the text in the larger boxes: 44 | 45 | ```{r warning=FALSE, fig.width = 12, fig.height = 8} 46 | # Create labels for exclusion box: 47 | label_exc <- paste( 48 | c(str_glue("{sum(safo$inclusion_crit == 'Yes' | safo$exclusion_crit == 'Yes' | safo$decline_part == 'Yes', na.rm = T)} excluded:"), 49 | map_chr(c("inclusion_crit", "decline_part", "exclusion_crit"), ~str_glue("{sum(safo[[.x]] == 'Yes', na.rm = TRUE)} {attr(safo[[.x]], 'label')}")), 50 | map_chr(4:15, ~str_glue(" - {sum(safo[[.x]] == 'Yes')} {attr(safo[[.x]], 'label')}"))), 51 | collapse = "\n") 52 | 53 | label_exc <- gsub("exclusion criteria", "exclusion criteria:", label_exc) 54 | 55 | safo1 <- safo |> 56 | filter(group == "cloxacillin plus fosfomycin", !is.na(reason_pp)) |> 57 | mutate(reason_pp = droplevels(reason_pp)) 58 | 59 | label_exc1 <- paste( 60 | c(str_glue("{nrow(safo1)} excluded:"), 61 | map_chr(levels(safo1$reason_pp), ~str_glue(" - {sum(safo1$reason_pp == .x)} {.x}"))), 62 | collapse = "\n") 63 | 64 | label_exc1 <- str_replace_all(label_exc1, c("nosocomial" = "nosocomial\n", "treatment" = "treatment\n")) 65 | 66 | safo2 <- safo |> 67 | filter(group == "cloxacillin alone", !is.na(reason_pp)) |> 68 | mutate(reason_pp = droplevels(reason_pp)) 69 | 70 | label_exc2 <- paste( 71 | c(str_glue("{nrow(safo2)} excluded:"), 72 | map_chr(levels(safo2$reason_pp), ~str_glue(" - {sum(safo2$reason_pp == .x)} {.x}"))), 73 | collapse = "\n") 74 | 75 | label_exc2 <- str_replace_all(label_exc2, c("resistant" = "resistant\n", "blood" = "blood\n")) 76 | 77 | ``` 78 | 79 | Second, let's create and customise the `flowchart` using the functions in the package: 80 | 81 | ```{r warning=FALSE, fig.width = 13, fig.height = 10} 82 | safo |> 83 | as_fc(label = "patients assessed for eligibility", text_pattern = "{N} {label}") |> 84 | fc_filter(!is.na(group), label = "randomized", text_pattern = "{n} {label}", show_exc = TRUE, just_exc = "left", text_pattern_exc = "{label}", label_exc = label_exc, text_fs_exc = 7, offset_exc = 0.15) |> 85 | fc_split(group, text_pattern = "{n} asssigned\n {label}") |> 86 | fc_filter(itt == "Yes", label = "included in intention-to-treat\n population", show_exc = TRUE, text_pattern = "{n} {label}", label_exc = "patient did not receive allocated\n treatment (withdrew consent)", text_pattern_exc = "{n} {label}", text_fs_exc = 7) |> 87 | fc_filter(pp == "Yes", label = "included in per-protocol\n population", show_exc = TRUE, just_exc = "left", text_pattern = "{n} {label}", text_fs_exc = 7) |> 88 | fc_modify( 89 | ~.x |> 90 | filter(n != 0) |> 91 | mutate( 92 | text = case_when(id == 11 ~ label_exc1, id == 13 ~ label_exc2, TRUE ~ text) 93 | ) 94 | ) |> 95 | fc_draw() 96 | ``` 97 | 98 | # Example 3 99 | 100 | In this example, we will create a `flowchart` without any `data.frame`, using the `N` argument to manually specify the numbers to display in the boxes: 101 | 102 | ```{r warning=FALSE, fig.width = 7, fig.height = 6} 103 | as_fc(N = 300) |> 104 | fc_filter(N = 240, label = "Randomized patients", show_exc = TRUE) |> 105 | fc_split(N = c(100, 80, 60), label = c("Group A", "Group B", "Group C")) |> 106 | fc_filter(N = c(80, 75, 50), label = "Finished the study") |> 107 | fc_draw() 108 | ``` 109 | 110 | # Example 4 111 | 112 | The use of `N=` argument can be combined with the use of a `data.frame`. In this example, we will use the `N=` argument in a `flowchart` that uses a `data.frame`: 113 | 114 | ```{r warning=FALSE, fig.width = 7, fig.height = 6} 115 | 116 | safo |> 117 | as_fc(label = "Patients assessed for eligibility") |> 118 | fc_filter(!is.na(group), label = "Randomized", show_exc = TRUE) |> 119 | fc_split(group) |> 120 | fc_split(N = c(50, 55, 10, 100), label = c("Group A", "Group B")) |> 121 | fc_draw() 122 | 123 | ``` 124 | -------------------------------------------------------------------------------- /vignettes/articles/flowchart-customization.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Flowchart Customization" 3 | output: 4 | rmarkdown::html_vignette: 5 | toc: true 6 | toc_depth: 5 7 | number_sections: true 8 | vignette: > 9 | %\VignetteIndexEntry{Flowchart Customization} 10 | %\VignetteEncoding{UTF-8} 11 | %\VignetteEngine{knitr::rmarkdown} 12 | editor_options: 13 | chunk_output_type: console 14 | --- 15 | 16 | ```{r message=FALSE, warning=FALSE, include=FALSE} 17 | library(flowchart) 18 | library(dplyr) 19 | library(tidyr) 20 | library(purrr) 21 | library(stringr) 22 | library(tibble) 23 | ``` 24 | 25 | We can customize the `flowchart` either with the arguments provided by each function in the process of creating it, or directly in the final output using the `fc_theme()` or `fc_modify()` functions. 26 | 27 | # Change function arguments 28 | 29 | There are many different arguments in `as_fc()`, `fc_filter()`, `fc_split()`, and `fc_draw()` that allow you to customize the boxes created at each step. See the documentation for these functions for more information. Some examples of how to use these arguments are given at the end of the vignette: [Customization examples]. 30 | 31 | # Functions to customize the `flowchart` 32 | 33 | ## `fc_theme()` 34 | 35 | We can use `fc_theme()` to set all parameters for all boxes in a flowchart at once. This is useful if we want to apply the same style to all the boxes. For example, let's customize the following `flowchart`: 36 | 37 | ```{r} 38 | safo |> 39 | dplyr::filter(!is.na(group)) |> 40 | as_fc(label = "Randomized patients") |> 41 | fc_split(group) |> 42 | fc_draw() 43 | ``` 44 | 45 | Let's change the style of all the boxes: 46 | 47 | ```{r} 48 | safo |> 49 | dplyr::filter(!is.na(group)) |> 50 | as_fc(label = "Randomized patients") |> 51 | fc_split(group) |> 52 | fc_theme(text_fs = 11, text_color = "#324C54", text_fface = 2, bg_fill = "#ADD8E6") |> 53 | fc_draw() 54 | ``` 55 | 56 | ## `fc_modify()` 57 | 58 | The function `fc_modify` allows the user to customise the created `flowchart` by modifying its parameters, which are stored in `.$fc`. 59 | 60 | For example, let's customize the following `flowchart`: 61 | 62 | ```{r fig.width = 6, fig.height = 4} 63 | safo_fc <- safo |> 64 | as_fc(label = "Patients assessed for eligibility") |> 65 | fc_filter(!is.na(group), label = "Randomized", show_exc = TRUE) 66 | 67 | safo_fc |> 68 | fc_draw() 69 | ``` 70 | 71 | Previous to modifying it, we can use the function fc_view() to inspect the element $fc that we want to change: 72 | 73 | ```{r} 74 | safo_fc |> 75 | fc_view("fc") 76 | ``` 77 | 78 | Let’s customise the text in the exclusion box (id = 3) to specify different reasons for exclusion, and change the x and y coordinate: 79 | 80 | ```{r} 81 | safo_fc |> 82 | fc_modify( 83 | ~ . |> 84 | mutate( 85 | text = ifelse(id == 3, str_glue("- {sum(safo$inclusion_crit == 'Yes')} not met the inclusion criteria\n- {sum(safo$exclusion_crit == 'Yes')} met the exclusion criteria"), text), 86 | x = case_when( 87 | id == 3 ~ 0.75, 88 | TRUE ~ x 89 | ), 90 | y = case_when( 91 | id == 1 ~ 0.8, 92 | id == 2 ~ 0.2, 93 | TRUE ~ y 94 | ) 95 | ) 96 | ) |> 97 | fc_draw() 98 | ``` 99 | 100 | # Customization examples 101 | 102 | In these examples, we will explore some of the arguments to customize the following `flowchart`: 103 | 104 | ```{r fig.width = 6, fig.height = 5} 105 | safo |> 106 | as_fc(label = "Patients assessed for eligibility") |> 107 | fc_filter(!is.na(group), label = "Randomized", show_exc = TRUE) |> 108 | fc_split(group) |> 109 | fc_draw() 110 | ``` 111 | 112 | ## Change the `flowchart` appearance 113 | 114 | You can set the background color of each box using `bg_fill=`: 115 | 116 | ```{r fig.width = 6, fig.height = 5} 117 | safo |> 118 | as_fc(label = "Patients assessed for eligibility", width = 0.6, text_fs = 10, text_fface = 2, text_ffamily = "serif", text_padding = 2, bg_fill = "lightgrey") |> 119 | fc_filter(!is.na(group), label = "Randomized", show_exc = TRUE, text_color = "white", bg_fill = "darkgreen", text_color_exc = "white", bg_fill_exc = "firebrick") |> 120 | fc_split(group, bg_fill = c("darkblue", "purple"), text_color = "white") |> 121 | fc_modify( 122 | ~ . |> 123 | mutate( 124 | y = case_when( 125 | type == "init" ~ 0.8, 126 | .default = y 127 | ) 128 | ) 129 | ) |> 130 | fc_draw() 131 | ``` 132 | 133 | You can also alter the background of the canvas behind the `flowchart` boxes using the `bg_canvas=` argument in `fc_draw`: 134 | 135 | ```{r fig.width = 6, fig.height = 5} 136 | safo |> 137 | as_fc(label = "Patients assessed for eligibility", width = 0.6, text_fs = 10, text_fface = 2, text_ffamily = "serif", text_padding = 2, bg_fill = "lightgrey") |> 138 | fc_filter(!is.na(group), label = "Randomized", show_exc = TRUE, text_color = "white", bg_fill = "darkgreen", text_color_exc = "white", bg_fill_exc = "firebrick") |> 139 | fc_split(group, bg_fill = c("darkblue", "purple"), text_color = "white") |> 140 | fc_modify( 141 | ~ . |> 142 | mutate( 143 | y = case_when( 144 | type == "init" ~ 0.8, 145 | .default = y 146 | ) 147 | ) 148 | ) |> 149 | fc_draw(canvas_bg = "darkgrey") 150 | ``` 151 | 152 | ## Add a title to the `flowchart` 153 | 154 | We can add a title to the `flowchart` using the argument `title=` in the `fc_draw()` function: 155 | 156 | ```{r fig.width = 6, fig.height = 5} 157 | safo |> 158 | as_fc(label = "Patients assessed for eligibility") |> 159 | fc_filter(!is.na(group), label = "Randomized", show_exc = TRUE) |> 160 | fc_split(group) |> 161 | fc_draw(title = "SAFO flowchart") 162 | ``` 163 | 164 | ### Add a title to the split 165 | 166 | We can also add a title to a split in the `flowchart`, using the argument `title` in the `fc_split()` function: 167 | 168 | ```{r fig.width = 6, fig.height = 5} 169 | safo |> 170 | as_fc(label = "Patients assessed for eligibility") |> 171 | fc_filter(!is.na(group), label = "Randomized", show_exc = TRUE, perc_total = TRUE) |> 172 | fc_split(group, perc_total = TRUE, title = "Treatment", bg_fill_title = "skyblue") |> 173 | fc_draw() 174 | ``` 175 | 176 | ### Percentage with respect to the total rows 177 | 178 | We can change the calculation of all percentages in a `flowchart.` By default, percentages are calculated with respect to the box in the previous level. With the argument `perc_total=` we can change it, to calculate it with respect to the initial box with the total number of rows: 179 | 180 | ```{r fig.width = 6, fig.height = 5} 181 | safo |> 182 | as_fc(label = "Patients assessed for eligibility") |> 183 | fc_filter(!is.na(group), label = "Randomized", show_exc = TRUE, perc_total = TRUE) |> 184 | fc_split(group, perc_total = TRUE) |> 185 | fc_draw() 186 | ``` 187 | 188 | ### Offset 189 | 190 | We can add/remove space to the distance between boxes in a split using the argument `offset`: 191 | 192 | ```{r fig.width = 6, fig.height = 5} 193 | safo |> 194 | as_fc(label = "Patients assessed for eligibility") |> 195 | fc_filter(!is.na(group), label = "Randomized", show_exc = TRUE, perc_total = TRUE) |> 196 | fc_split(group, offset = 0.1) |> 197 | fc_draw() 198 | 199 | safo |> 200 | as_fc(label = "Patients assessed for eligibility") |> 201 | fc_filter(!is.na(group), label = "Randomized", show_exc = TRUE, perc_total = TRUE) |> 202 | fc_split(group, offset = -0.1) |> 203 | fc_draw() 204 | ``` 205 | 206 | We can also add/remove space to the distance between the excluded box in a filter using the argument `offset_exc`: 207 | 208 | ```{r fig.width = 6, fig.height = 5} 209 | safo |> 210 | as_fc(label = "Patients assessed for eligibility") |> 211 | fc_filter(!is.na(group), label = "Randomized", show_exc = TRUE, offset_exc = 0.1) |> 212 | fc_split(group) |> 213 | fc_draw() 214 | ``` 215 | 216 | ## Change Box Corner Style 217 | 218 | We can change the corner style of the `flowchart` boxes using the `box_corners` argument with `fc_draw`: 219 | 220 | ```{r fig.width = 6, fig.height = 5} 221 | safo |> 222 | as_fc(label = "Patients assessed for eligibility") |> 223 | fc_filter(!is.na(group), label = "Randomized", show_exc = TRUE) |> 224 | fc_split(group) |> 225 | fc_draw(box_corners = "sharp") 226 | ``` 227 | 228 | 229 | ## Use expressions 230 | 231 | We can use expressions in the label or the text pattern of each box. Expressions allow you to use bold or italic text without having to change the font of all the box text. 232 | 233 | For example, let's put and expression in the label: 234 | 235 | ```{r} 236 | safo |> 237 | as_fc(label = expression(paste("Patients ", italic("assessed"), " for ", bold("eligibility")))) |> 238 | fc_draw() 239 | ``` 240 | 241 | Now, let's use it also in the text pattern of the box: 242 | 243 | ```{r} 244 | safo |> 245 | as_fc(label = expression(paste("Patients ", italic("assessed"), " for ", bold("eligibility"))), text_pattern = expression(paste("{label}", bold("{n}")))) |> 246 | fc_filter(filter = chronic_heart_failure == "No", 247 | label = expression(paste(italic("No chronic"), bold(" heart failure"))), 248 | label_exc = expression(paste(bold("Chronic"), " heart failure")), 249 | text_pattern = expression(paste("{label}", N, " = ", bold("{n}"), "/{N}: ", italic("{perc}"), "%")), 250 | text_pattern_exc = expression(paste("{label}", bold("{n}"), "({perc})%")), 251 | show_exc = TRUE) |> 252 | fc_draw() 253 | ``` 254 | 255 | Expressions even allow the use of formulas. For example: 256 | 257 | ```{r} 258 | as_fc(N = 500, label = expression(paste(y, " = ", alpha, " + ", beta, x)), text_pattern = expression(paste("{label}", bold("{n}")))) |> 259 | fc_draw() 260 | ``` 261 | 262 | ## Split in one group 263 | 264 | We can perform an additional split only in one of the groups using the argument `sel_group=`: 265 | 266 | ```{r fig.width = 6, fig.height = 6} 267 | safo |> 268 | as_fc(label = "Patients assessed for eligibility") |> 269 | fc_filter(!is.na(group), label = "Randomized", show_exc = TRUE) |> 270 | fc_split(group) |> 271 | fc_split(N = c(50, 60), sel_group = "cloxacillin alone") |> 272 | fc_draw() 273 | ``` 274 | 275 | Then, we could also perform a filter in the other group: 276 | 277 | ```{r fig.width = 6, fig.height = 6} 278 | safo |> 279 | as_fc(label = "Patients assessed for eligibility") |> 280 | fc_filter(!is.na(group), label = "Randomized", show_exc = TRUE) |> 281 | fc_split(group) |> 282 | fc_split(N = c(50, 60), sel_group = "cloxacillin alone") |> 283 | fc_filter(N = 50, sel_group = "cloxacillin plus fosfomycin") |> 284 | fc_draw() 285 | ``` 286 | 287 | If we want to select a group in a `flowchart` with more than two groups we have to supply a vector in `sel_group=` with the desired groups to be selected: 288 | 289 | ```{r fig.width = 6, fig.height = 7} 290 | safo |> 291 | as_fc(label = "Patients assessed for eligibility") |> 292 | fc_filter(!is.na(group), label = "Randomized", show_exc = TRUE) |> 293 | fc_split(group) |> 294 | fc_split(N = c(50, 55, 10, 100)) |> 295 | fc_filter(N = 60, sel_group = c("cloxacillin alone", "group 2")) |> 296 | fc_draw() 297 | ``` 298 | 299 | Previous to modifying it, we can use the function `fc_view()` to inspect the element `$fc` that we want to change: 300 | 301 | ```{r} 302 | safo_fc |> 303 | fc_view("fc") 304 | ``` 305 | 306 | Let's customise the text in the exclusion box (`id = 3`) to specify different reasons for exclusion, and change the _x_ and _y_ coordinate: 307 | 308 | ```{r fig.width = 7, fig.height = 5} 309 | safo_fc |> 310 | fc_modify( 311 | ~ . |> 312 | mutate( 313 | text = ifelse(id == 3, str_glue("- {sum(safo$inclusion_crit == 'Yes')} not met the inclusion criteria\n- {sum(safo$exclusion_crit == 'Yes')} met the exclusion criteria"), text), 314 | x = case_when( 315 | id == 3 ~ 0.75, 316 | TRUE ~ x 317 | ), 318 | y = case_when( 319 | id == 1 ~ 0.8, 320 | id == 2 ~ 0.2, 321 | TRUE ~ y 322 | ) 323 | ) 324 | ) |> 325 | fc_draw() 326 | ``` 327 | -------------------------------------------------------------------------------- /vignettes/flowchart.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "flowchart" 3 | output: 4 | rmarkdown::html_vignette: 5 | toc: true 6 | toc_depth: 5 7 | number_sections: true 8 | package: "`flowchart`" 9 | vignette: > 10 | %\VignetteIndexEntry{flowchart} 11 | %\VignetteEncoding{UTF-8} 12 | %\VignetteEngine{knitr::rmarkdown} 13 | editor_options: 14 | chunk_output_type: console 15 | --- 16 | 17 | ```{r message=FALSE, warning=FALSE, include=FALSE} 18 | library(flowchart) 19 | library(dplyr) 20 | library(tidyr) 21 | library(purrr) 22 | library(stringr) 23 | library(tibble) 24 | ``` 25 | 26 | # Overview 27 | 28 | `flowchart` is a package for drawing participant flow diagrams directly from a `data.frame` using tidyverse. It provides a set of functions that can be combined with `|>` to create all kinds of `flowchart`s from a `data.frame` in an easy way: 29 | 30 | - `as_fc()` transforms a `data.frame` into a `fc` object that can be manipulated by the package 31 | 32 | - `fc_split()` splits a `flowchart` according to the different values of a column in the `data.frame` 33 | 34 | - `fc_filter()` creates a filtered box from the `flowchart`, based on the evaluation of an expression in the `data.frame` 35 | 36 | - `fc_merge()` combines horizontally two different `flowchart`s 37 | 38 | - `fc_stack()` combines vertically two different `flowchart`s 39 | 40 | - `fc_modify()` allows to modify the parameters of the `flowchart` which are stored in `.$fc` 41 | 42 | - `fc_draw()` draws the `flowchart` created by the previous functions 43 | 44 | - `fc_export()` allows to export the `flowchart` drawn to the desired format 45 | 46 | # Installation 47 | 48 | We can install the stable version in CRAN: 49 | 50 | ```{r eval=FALSE} 51 | install.packages("flowchart") 52 | ``` 53 | 54 | Or the development version from GitHub: 55 | 56 | ```{r eval=FALSE} 57 | # install.packages("remotes") 58 | remotes::install_github('bruigtp/flowchart') 59 | ``` 60 | 61 | # `safo` dataset 62 | 63 | We will use the built-in dataset `safo`, which is a randomly generated dataset from the SAFO trial[^1]. SAFO is an open-label, multicentre, phase III–IV superiority randomised clinical trial designed to assess whether cloxacillin plus fosfomycin administered during the first 7 days of therapy achieves better treatment outcomes than cloxacillin alone in hospitalised patients with meticillin-sensitive Staphylococcus aureus bacteraemia. 64 | 65 | [^1]: Grillo, S., Pujol, M., Miró, J.M. et al. Cloxacillin plus fosfomycin versus cloxacillin alone for methicillin-susceptible Staphylococcus aureus bacteremia: a randomized trial. Nat Med 29, 2518–2525 (2023). https://doi.org/10.1038/s41591-023-02569-0 66 | 67 | ```{r} 68 | library(flowchart) 69 | 70 | data(safo) 71 | 72 | head(safo) 73 | ``` 74 | 75 | # Basic operations 76 | 77 | The first step is to initialise the `flowchart` with `as_fc`. The last step, if we want to visualise the created `flowchart`, is to draw the `flowchart` with `fc_draw`. In between we can combine the functions `fc_split`., `fc_filter`, `fc_merge`, `fc_stack` with the operator pipe (`|>` or `%>$`) to create complex `flowchart` structures. 78 | 79 | ## Initialize 80 | 81 | To initialize a `flowchart` from a dataset we have to use the `as_fc()` function: 82 | 83 | ```{r} 84 | safo_fc <- safo |> 85 | as_fc() 86 | 87 | str(safo_fc, max.level = 1) 88 | ``` 89 | 90 | The `safo_fc` object created is a `fc` object, which consists of a list containing the tibble of the `data.frame` associated with the `flowchart` and the tibble that stores the `flowchart` parameters. In this example, `safo_fc$data` corresponds to the `safo` dataset while `safo_fc$fc` contains the parameters of the initial `flowchart`: 91 | 92 | ```{r} 93 | safo_fc$fc 94 | ``` 95 | 96 | Alternatively, if a `data.frame` is not available, we can initialize a `flowchart` using the `N =` argument manually specifying the number of rows: 97 | 98 | ```{r include=FALSE} 99 | as_fc(N = 230) 100 | ``` 101 | 102 | ## Draw 103 | 104 | The function `fc_draw()` allows to draw the `flowchart` associated to any `fc` object. Following the last example, we can draw the initial `flowchart` that has been previously created: 105 | 106 | ```{r} 107 | safo_fc |> 108 | fc_draw() 109 | ``` 110 | 111 | ## Filter 112 | 113 | We can filter the `flowchart` using `fc_filter()` specifying the logic in which the filter is to be applied. For example, we can show the number of patients that were randomized in the study: 114 | 115 | ```{r fig.width = 6, fig.height = 5} 116 | safo |> 117 | as_fc(label = "Patients assessed for eligibility") |> 118 | fc_filter(!is.na(group), label = "Randomized", show_exc = TRUE) |> 119 | fc_draw() 120 | ``` 121 | 122 | Percentages are calculated from the box in the previous level. See 'Modify function arguments' for more information on the `label=` and `show_exc=` arguments. 123 | 124 | Alternatively, if the column to filter is not available, we can use the `N =` argument to manually specify the number of rows of the resulting filter: 125 | 126 | ```{r fig.width = 6, fig.height = 5} 127 | safo |> 128 | as_fc(label = "Patients assessed for eligibility") |> 129 | fc_filter(N = 215, label = "Randomized", show_exc = TRUE) |> 130 | fc_draw() 131 | ``` 132 | 133 | ## Split 134 | 135 | We can split the `flowchart` into groups using `fc_split()` specifying the grouping variable. The function will split the `flowchart` into as many categories as the specified variable has. For example, we can split the previous `flowchart` showing the patients allocated in the two study treatments: 136 | 137 | ```{r fig.width = 6, fig.height = 5} 138 | safo |> 139 | dplyr::filter(!is.na(group)) |> 140 | as_fc(label = "Randomized patients") |> 141 | fc_split(group) |> 142 | fc_draw() 143 | ``` 144 | 145 | Percentages are calculated from the box in the previous level. 146 | 147 | Alternatively, if the column to split is not available, we can use the `N =` argument to manually specify the number of rows in each group of the resulting split: 148 | 149 | ```{r fig.width = 6, fig.height = 5} 150 | safo |> 151 | dplyr::filter(!is.na(group)) |> 152 | as_fc(label = "Randomized patients") |> 153 | fc_split(N = c(105, 110), label = c("cloxacillin plus fosfomycin", "cloxacillin alone")) |> 154 | fc_draw() 155 | ``` 156 | 157 | The idea is to combine the `fc_filter()` and `fc_split()` functions in the way we want to create different `flowchart` structures, however complex the may be. In some cases, we may want to create two different `flowcharts` then [merge or stack](combine-flowcharts.html) them into the same image. 158 | 159 | ## Export 160 | 161 | Once the `flowchart` has been drawn we can export it to the most popular image formats, including both bitmap (png, jpeg, tiff, bmp) and vector (svg, pdf) formats, using `fc_export()`: 162 | 163 | ```{r eval = FALSE} 164 | safo |> 165 | as_fc(label = "Patients assessed for eligibility") |> 166 | fc_filter(!is.na(group), label = "Randomized", show_exc = TRUE) |> 167 | fc_draw() |> 168 | fc_export("flowchart.png") 169 | ``` 170 | 171 | We can change the size and resolution of the stored image. 172 | 173 | ```{r eval = FALSE} 174 | safo |> 175 | as_fc(label = "Patients assessed for eligibility") |> 176 | fc_filter(!is.na(group), label = "Randomized", show_exc = TRUE) |> 177 | fc_draw() |> 178 | fc_export("flowchart.png", width = 3000, height = 4000, res = 700) 179 | ``` 180 | 181 | # Additional Details 182 | 183 | This vignette only covers the basic functionality of `flowchart`. Users may also be interested in more advanced functionality covered in the available articles, such as how to [customize a `flowchart`](flowchart-customization.html), or examples in the [Example Gallery](example-gallery.html). 184 | --------------------------------------------------------------------------------