├── .Rbuildignore ├── .editorconfig ├── .eslintrc.js ├── .gitattributes ├── .github └── workflows │ └── ci.yml ├── .gitignore ├── .lintr ├── .prettierrc.js ├── .release-it.json ├── .yarn └── releases │ └── yarn-3.2.0.cjs ├── .yarnrc.yml ├── CRAN-RELEASE ├── DESCRIPTION ├── LICENSE ├── R ├── attributes.R ├── dash.R ├── data-helpers.R ├── data.R ├── got.R ├── queries.R ├── reexport.R ├── selection.R ├── shiny.R ├── style.R ├── upsetjs-package.R ├── upsetjs.R └── utils.R ├── README.md ├── _pkgdown.yml ├── bench.R ├── binder ├── environment.yml ├── postBuild └── runtime.txt ├── cran-comments.md ├── dash └── basic.R ├── data-raw ├── got.R └── got.csv ├── data └── got.rda ├── inst └── htmlwidgets │ └── upsetjs.yaml ├── js ├── _polyfills.ts ├── dash.tsx ├── htmlwidget.ts ├── model.ts └── utils.ts ├── package.json ├── scripts └── bump.js ├── shiny ├── basic.R ├── crosstalk.R ├── events.R ├── selection.R ├── selectionP │ └── app.R └── selectionProxy.R ├── tests ├── testthat.R └── testthat │ ├── data │ ├── toyset_1.tsv.gz │ └── toyset_2.tsv.gz │ ├── helpers.R │ ├── test-data.R │ ├── test-toyset1.R │ └── test-toyset2.R ├── tsconfig.json ├── types └── index.d.ts ├── upsetjs.Rproj ├── vignettes ├── colors.Rmd ├── combinationModes.Rmd ├── got.Rmd ├── kmap.Rmd ├── upsetjs.Rmd └── venn.Rmd ├── webpack.config.js └── yarn.lock /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^.*\..Rcheck$ 3 | ^\.Rproj\.user$ 4 | 5 | ^doc$ 6 | ^shiny$ 7 | ^dash$ 8 | ^docs$ 9 | ^Meta$ 10 | ^js$ 11 | ^scripts$ 12 | ^types$ 13 | ^\.github$ 14 | ^\.vscode$ 15 | ^binder$ 16 | ^node_modules$ 17 | ^\.yarn$ 18 | 19 | ^.*\.map$ 20 | ^\.prettierrc\.js$ 21 | ^\.eslintrc\.js$ 22 | ^\webpack\.config\.js$ 23 | ^.*\.mjs$ 24 | ^.*\.json$ 25 | ^.*\.cjs$ 26 | ^.*\.tar\.gz$ 27 | ^\.lintr$ 28 | ^yarn\.lock$ 29 | ^bench\.R$ 30 | ^\.yarnrc\.yml$ 31 | 32 | ^_pkgdown\.yml$ 33 | ^pkgdown$ 34 | ^data-raw$ 35 | ^cran-comments.md$ 36 | ^.editorconfig$ 37 | ^CRAN-RELEASE$ 38 | ^CRAN-SUBMISSION$ 39 | -------------------------------------------------------------------------------- /.editorconfig: -------------------------------------------------------------------------------- 1 | # EditorConfig helps developers define and maintain consistent 2 | # coding styles between different editors and IDEs 3 | # editorconfig.org 4 | 5 | root = true 6 | 7 | 8 | [*] 9 | 10 | # Change these settings to your own preference 11 | indent_style = space 12 | indent_size = 2 13 | 14 | # We recommend you to keep these unchanged 15 | end_of_line = lf 16 | charset = utf-8 17 | trim_trailing_whitespace = true 18 | insert_final_newline = true 19 | 20 | [*.md] 21 | trim_trailing_whitespace = false 22 | -------------------------------------------------------------------------------- /.eslintrc.js: -------------------------------------------------------------------------------- 1 | module.exports = { 2 | extends: ['react-app', 'plugin:prettier/recommended'], 3 | settings: { 4 | react: { 5 | version: '99.99.99', 6 | }, 7 | }, 8 | }; 9 | -------------------------------------------------------------------------------- /.gitattributes: -------------------------------------------------------------------------------- 1 | # These settings are for any web project 2 | 3 | # Handle line endings automatically for files detected as text 4 | # and leave all files detected as binary untouched. 5 | * text=auto eol=lf 6 | 7 | # 8 | # The above will handle all files NOT found below 9 | # 10 | 11 | # 12 | ## These files are text and should be normalized (Convert crlf => lf) 13 | # 14 | 15 | # source code 16 | *.php text 17 | *.css text 18 | *.sass text 19 | *.scss text 20 | *.less text 21 | *.styl text 22 | *.js text 23 | *.ts text 24 | *.coffee text 25 | *.json text 26 | *.htm text 27 | *.html text 28 | *.xml text 29 | *.txt text 30 | *.ini text 31 | *.inc text 32 | *.pl text 33 | *.rb text 34 | *.py text 35 | *.scm text 36 | *.sql text 37 | *.sh text eof=LF 38 | *.bat text 39 | 40 | # templates 41 | *.hbt text 42 | *.jade text 43 | *.haml text 44 | *.hbs text 45 | *.dot text 46 | *.tmpl text 47 | *.phtml text 48 | 49 | # server config 50 | .htaccess text 51 | 52 | # git config 53 | .gitattributes text 54 | .gitignore text 55 | 56 | # code analysis config 57 | .jshintrc text 58 | .jscsrc text 59 | .jshintignore text 60 | .csslintrc text 61 | 62 | # misc config 63 | *.yaml text 64 | *.yml text 65 | .editorconfig text 66 | 67 | # build config 68 | *.npmignore text 69 | *.bowerrc text 70 | Dockerfile text eof=LF 71 | 72 | # Heroku 73 | Procfile text 74 | .slugignore text 75 | 76 | # Documentation 77 | *.md text 78 | LICENSE text 79 | AUTHORS text 80 | 81 | 82 | # 83 | ## These files are binary and should be left untouched 84 | # 85 | 86 | # (binary is a macro for -text -diff) 87 | *.png binary 88 | *.jpg binary 89 | *.jpeg binary 90 | *.gif binary 91 | *.ico binary 92 | *.mov binary 93 | *.mp4 binary 94 | *.mp3 binary 95 | *.flv binary 96 | *.fla binary 97 | *.swf binary 98 | *.gz binary 99 | *.zip binary 100 | *.7z binary 101 | *.ttf binary 102 | *.pyc binary 103 | *.pdf binary 104 | 105 | # Source files 106 | # ============ 107 | *.pxd text 108 | *.py text 109 | *.py3 text 110 | *.pyw text 111 | *.pyx text 112 | *.sh text eol=lf 113 | *.json text 114 | 115 | # Binary files 116 | # ============ 117 | *.db binary 118 | *.p binary 119 | *.pkl binary 120 | *.pyc binary 121 | *.pyd binary 122 | *.pyo binary 123 | 124 | # Note: .db, .p, and .pkl files are associated 125 | # with the python modules ``pickle``, ``dbm.*``, 126 | # ``shelve``, ``marshal``, ``anydbm``, & ``bsddb`` 127 | # (among others). 128 | -------------------------------------------------------------------------------- /.github/workflows/ci.yml: -------------------------------------------------------------------------------- 1 | name: ci 2 | 3 | on: [push] 4 | 5 | jobs: 6 | build_r: 7 | runs-on: ubuntu-latest 8 | steps: 9 | - uses: actions/checkout@v2 10 | - uses: actions/setup-node@v2 11 | with: 12 | node-version: 14 13 | # build client code 14 | - run: npm i -g yarn 15 | - run: yarn config set checksumBehavior ignore 16 | - name: Cache Node.js modules 17 | uses: actions/cache@v2 18 | with: 19 | path: | 20 | ./.yarn/cache 21 | ./.yarn/unplugged 22 | key: ${{ runner.os }}-yarn2-v4-${{ hashFiles('**/yarn.lock') }} 23 | restore-keys: | 24 | ${{ runner.os }}-yarn2-v4 25 | - run: yarn install 26 | - run: yarn build 27 | - run: yarn clean:r 28 | - uses: r-lib/actions/setup-r@v1 29 | with: 30 | use-public-rspm: true 31 | - uses: r-lib/actions/setup-r-dependencies@v1 32 | with: 33 | extra-packages: | 34 | webshot 35 | textshaping 36 | devtools 37 | 38 | - name: Style / Format 39 | shell: Rscript {0} 40 | run: styler::style_pkg(dry="fail") 41 | 42 | - name: Lint 43 | shell: Rscript {0} 44 | run: | 45 | devtools::document() 46 | devtools::load_all() 47 | lintr::lint_package() 48 | 49 | - name: Check 50 | env: 51 | _R_CHECK_CRAN_INCOMING_REMOTE_: false 52 | shell: Rscript {0} 53 | run: | 54 | devtools::document() 55 | devtools::check(args = c("--no-manual", "--as-cran"), error_on = "error", check_dir = "check") 56 | 57 | - name: Test 58 | shell: Rscript {0} 59 | run: devtools::test() 60 | 61 | - name: Upload check results 62 | if: failure() 63 | uses: actions/upload-artifact@v2 64 | with: 65 | name: ${{ runner.os }}-results 66 | path: check 67 | 68 | - name: Build Package 69 | run: yarn build:r 70 | - name: Prepare Docs 71 | run: | 72 | mkdir -p public/integrations/r 73 | cp ./upsetjs.tar.gz public/integrations/r/ 74 | - name: Build Website 75 | run: yarn docs:r 76 | - name: Copy Docs 77 | run: | 78 | mv docs/* public/integrations/r/ 79 | 80 | - name: Deploy Main 81 | if: github.ref == 'refs/heads/main' && github.event_name == 'push' 82 | uses: upsetjs/actions-gh-pages@sgratzl 83 | env: 84 | ACTIONS_ALLOW_UNSECURE_COMMANDS: true 85 | with: 86 | deploy_key: ${{ secrets.ACTIONS_DEPLOY_KEY }} 87 | external_repository: upsetjs/upsetjs.github.io 88 | publish_branch: main 89 | publish_dir: ./public 90 | enable_jekyll: true 91 | remove_path_spec: 'integrations/r/' 92 | 93 | - if: github.ref == 'refs/heads/develop' 94 | # move to next directory 95 | run: | 96 | mv public public2 97 | mkdir -p public 98 | mv public2 public/next 99 | 100 | - name: Deploy Develop 101 | if: github.ref == 'refs/heads/develop' && github.event_name == 'push' 102 | uses: upsetjs/actions-gh-pages@sgratzl 103 | env: 104 | ACTIONS_ALLOW_UNSECURE_COMMANDS: true 105 | with: 106 | deploy_key: ${{ secrets.ACTIONS_DEPLOY_KEY }} 107 | external_repository: upsetjs/upsetjs.github.io 108 | publish_branch: main 109 | publish_dir: ./public 110 | enable_jekyll: true 111 | remove_path_spec: 'next/integrations/r/' 112 | 113 | build_node: 114 | runs-on: ubuntu-latest 115 | steps: 116 | - uses: actions/checkout@v2 117 | - uses: actions/setup-node@v2 118 | with: 119 | node-version: 14 120 | # build client code 121 | - run: npm i -g yarn 122 | - run: yarn config set checksumBehavior ignore 123 | - name: Cache Node.js modules 124 | uses: actions/cache@v2 125 | with: 126 | path: | 127 | ./.yarn/cache 128 | ./.yarn/unplugged 129 | key: ${{ runner.os }}-yarn2-v4-${{ hashFiles('**/yarn.lock') }} 130 | restore-keys: | 131 | ${{ runner.os }}-yarn2-v4 132 | - run: yarn install 133 | - run: yarn build 134 | - run: yarn lint 135 | # - run: yarn test --ci --coverage --maxWorkers=2 136 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | examples/*.html 5 | doc 6 | Meta 7 | node_modules 8 | .yarn/* 9 | !.yarn/patches 10 | !.yarn/releases 11 | !.yarn/plugins 12 | !.yarn/versions 13 | .pnp.* 14 | .vscode 15 | *.log 16 | *.map 17 | docs 18 | /*.tar.gz 19 | *.Rcheck 20 | .pnp.* 21 | /man 22 | /doc 23 | /docs 24 | /NAMESPACE 25 | /inst/htmlwidgets/upsetjs.js 26 | /inst/htmlwidgets/upsetjs.js.LICENSE.txt 27 | /inst/dash/ 28 | doc 29 | Meta 30 | /vignettes/*.R 31 | /vignettes/*.html 32 | -------------------------------------------------------------------------------- /.lintr: -------------------------------------------------------------------------------- 1 | linters: with_defaults( 2 | line_length_linter(200), 3 | object_name_linter = NULL, 4 | cyclocomp_linter = NULL, 5 | commented_code_linter = NULL 6 | ) 7 | -------------------------------------------------------------------------------- /.prettierrc.js: -------------------------------------------------------------------------------- 1 | module.exports = { 2 | printWidth: 120, 3 | semi: true, 4 | singleQuote: true, 5 | trailingComma: 'es5', 6 | }; 7 | -------------------------------------------------------------------------------- /.release-it.json: -------------------------------------------------------------------------------- 1 | { 2 | "hooks": { 3 | "before:init": "yarn lint && yarn check:r", 4 | "before:release": "yarn build && yarn build:r", 5 | "after:release": "echo Successfully released ${name} v${version} to ${repo.repository}." 6 | }, 7 | "git": { 8 | "tagName": "v${version}" 9 | }, 10 | "npm": { 11 | "publish": false 12 | }, 13 | "github": { 14 | "release": true, 15 | "assets": ["*.tar.gz"] 16 | }, 17 | "plugins": { 18 | "./scripts/bump.js": {} 19 | } 20 | } 21 | -------------------------------------------------------------------------------- /.yarnrc.yml: -------------------------------------------------------------------------------- 1 | yarnPath: .yarn/releases/yarn-3.2.0.cjs 2 | -------------------------------------------------------------------------------- /CRAN-RELEASE: -------------------------------------------------------------------------------- 1 | This package was submitted to CRAN on 2022-01-27. 2 | Once it is accepted, delete this file and tag the release (commit e268b48). 3 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: upsetjs 2 | Type: Package 3 | Title: 'HTMLWidget' Wrapper of 'UpSet.js' for Exploring Large Set Intersections 4 | Description: 'UpSet.js' is a re-implementation of 'UpSetR' to create interactive set visualizations for more than three sets. 5 | This is a 'htmlwidget' wrapper around the 'JavaScript' library 'UpSet.js'. 6 | Version: 1.11.1 7 | Date: 2022-07-13 8 | Author: Samuel Gratzl [aut, cre] 9 | Authors@R: person("Samuel", "Gratzl", email = "sam@sgratzl.com", role = c("aut", "cre")) 10 | Maintainer: Samuel Gratzl 11 | URL: https://github.com/upsetjs/upsetjs_r/ 12 | BugReports: https://github.com/upsetjs/upsetjs_r/issues 13 | Depends: R (>= 3.2.0) 14 | License: AGPL-3 | file LICENSE 15 | Encoding: UTF-8 16 | Imports: 17 | htmlwidgets, 18 | magrittr 19 | Suggests: 20 | knitr, 21 | crosstalk, 22 | rmarkdown, 23 | formatR, 24 | tibble, 25 | testthat, 26 | styler, 27 | lintr, 28 | pkgdown 29 | LazyData: true 30 | RoxygenNote: 7.2.0 31 | VignetteBuilder: knitr 32 | Roxygen: list(markdown = TRUE) 33 | Language: en-US 34 | KeepSource: true 35 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | ## License 2 | 3 | If you are using UpSet.js for a commercial project or in a commercial environment, you would need to get a commercial license by contacting sam@sgratzl.com. 4 | 5 | ### Commercial license 6 | 7 | If you want to use UpSet.js for a commercial application or in a commercial environment, the commercial license is the appropriate license. With this option, your source code is kept proprietary. 8 | 9 | ### Open-source license 10 | 11 | > GNU AFFERO GENERAL PUBLIC LICENSE 12 | > Version 3, 19 November 2007 13 | > Copyright (C) 2021 Samuel Gratzl (sam@sgratzl.com) 14 | -------------------------------------------------------------------------------- /R/attributes.R: -------------------------------------------------------------------------------- 1 | # 2 | # @upsetjs/r 3 | # https://github.com/upsetjs/upsetjs_r 4 | # 5 | # Copyright (c) 2021 Samuel Gratzl 6 | # 7 | 8 | cleanAttrName <- function(col) { 9 | # escape remove . 10 | gsub("[.]", "_", col) 11 | } 12 | 13 | 14 | #' 15 | #' set the attributes 16 | #' @param upsetjs an object of class \code{upsetjs} or \code{upsetjs_proxy} 17 | #' @param attrs the attributes to set 18 | #' @return the object given as first argument 19 | #' @examples 20 | #' upsetjs() %>% 21 | #' fromList(list(a = c(1, 2, 3), b = c(2, 3))) %>% 22 | #' setAttributes(list( 23 | #' attr = runif(3), 24 | #' cat = as.factor(sample(c("male", "female"), 3, replace = TRUE)) 25 | #' )) 26 | #' @export 27 | setAttributes <- function(upsetjs, attrs = list()) { 28 | checkUpSetCommonArgument(upsetjs) 29 | stopifnot(is.list(attrs) || is.data.frame(attrs)) 30 | rows <- if (is.list(attrs)) { 31 | NULL 32 | } else { 33 | rownames(attrs) 34 | } 35 | df <- as.data.frame(attrs) 36 | 37 | toDescription <- function(col, colname) { 38 | clazz <- class(col) 39 | if (clazz == "numeric") { 40 | list( 41 | type = "number", 42 | name = colname, 43 | domain = c(min(col, na.rm = TRUE), max(col, na.rm = TRUE)), 44 | values = col, 45 | rows = rows 46 | ) 47 | } else if (clazz == "factor") { 48 | list( 49 | type = "categorical", 50 | name = colname, 51 | categories = levels(col), 52 | values = col, 53 | rows = rows 54 | ) 55 | } else { 56 | stop("attr must be numeric or factor") 57 | } 58 | } 59 | # convert columns 60 | data <- mapply(toDescription, df, colnames(df), SIMPLIFY = FALSE) 61 | names(data) <- NULL 62 | setProperty(upsetjs, "attrs", data) 63 | } 64 | 65 | #' 66 | #' adds a new numeric attribute to the plot 67 | #' @param upsetjs an object of class \code{upsetjs} or \code{upsetjs_proxy} 68 | #' @param name name of the attribute 69 | #' @param values the values as a numeric vector 70 | #' @param min_value optional min domain value 71 | #' @param max_value optional max domain value 72 | #' @return the object given as first argument 73 | #' @examples 74 | #' upsetjs() %>% 75 | #' fromList(list(a = c(1, 2, 3), b = c(2, 3))) %>% 76 | #' addNumericAttribute("attr", runif(3)) 77 | #' @export 78 | addNumericAttribute <- function(upsetjs, 79 | name, 80 | values, 81 | min_value = NULL, 82 | max_value = NULL) { 83 | checkUpSetArgument(upsetjs) 84 | stopifnot(is.character(name), length(name) == 1) 85 | stopifnot(is.numeric(values)) 86 | 87 | appendProperty( 88 | upsetjs, 89 | "attrs", 90 | list( 91 | name = name, 92 | type = "numeric", 93 | domain = c(if (is.null(min_value)) { 94 | min(values, na.rm = TRUE) 95 | } else { 96 | min_value 97 | }, if (is.null(max_value)) { 98 | max(values, na.rm = TRUE) 99 | } else { 100 | max_value 101 | }), 102 | values = values 103 | ) 104 | ) 105 | } 106 | 107 | #' 108 | #' adds a new query to the plot 109 | #' @param upsetjs an object of class \code{upsetjs} or \code{upsetjs_proxy} 110 | #' @param name name of the attribute 111 | #' @param values the values as a factor 112 | #' @param categories optional categories otherweise the levels are used 113 | #' @return the object given as first argument 114 | #' @examples 115 | #' upsetjs() %>% 116 | #' fromList(list(a = c(1, 2, 3), b = c(2, 3))) %>% 117 | #' addCategoricalAttribute("attr", as.factor(sample(c("male", "female"), 3, replace = TRUE))) 118 | #' @export 119 | addCategoricalAttribute <- function(upsetjs, 120 | name, 121 | values, categories = NULL) { 122 | checkUpSetArgument(upsetjs) 123 | stopifnot(is.character(name), length(name) == 1) 124 | stopifnot(is.factor(values)) 125 | 126 | appendProperty( 127 | upsetjs, 128 | "attrs", 129 | list( 130 | name = name, 131 | type = "categorical", 132 | categories = if (is.null(categories)) { 133 | levels(values) 134 | } else { 135 | categories 136 | }, 137 | values = values 138 | ) 139 | ) 140 | } 141 | 142 | 143 | #' 144 | #' clears the list of attributes for incremental updates 145 | #' @param upsetjs an object of class \code{upsetjs} or \code{upsetjs_proxy} 146 | #' @return the object given as first argument 147 | #' @examples 148 | #' upsetjs() %>% 149 | #' fromList(list(a = c(1, 2, 3), b = c(2, 3))) %>% 150 | #' clearAttributes() 151 | #' @export 152 | clearAttributes <- function(upsetjs) { 153 | checkUpSetArgument(upsetjs) 154 | 155 | setProperty(upsetjs, "attrs", NULL) 156 | } 157 | -------------------------------------------------------------------------------- /R/dash.R: -------------------------------------------------------------------------------- 1 | # 2 | # @upsetjs/r 3 | # https://github.com/upsetjs/upsetjs_r 4 | # 5 | # Copyright (c) 2021 Samuel Gratzl 6 | # 7 | 8 | #' 9 | #' create a new upsetjs dash adapter 10 | #' @param children dash children 11 | #' @param id dash id 12 | #' @param width upsetjs width 13 | #' @param height upestjs height 14 | #' @return the set object 15 | #' @examples 16 | #' upsetjsDash("u") %>% fromList(list(a = c(1, 2, 3), b = c(2, 3))) 17 | #' @export 18 | upsetjsDash <- function(children = NULL, id = NULL, width = NULL, height = NULL) { 19 | props <- list( 20 | children = children, id = id, height = height, width = width, 21 | renderMode = "upset" 22 | ) 23 | if (length(props) > 0) { 24 | props <- props[!vapply(props, is.null, logical(1))] 25 | } 26 | component <- list( 27 | props = props, 28 | type = "DashUpSetJS", 29 | namespace = "upsetjs", 30 | propNames = c( 31 | "children", "id", "height", "width", "renderMode", "mode", 32 | "attrs", "sets", "combinations", "queryLegend", "queries", "interactive", "selection", 33 | "heightRatios", "widthRatios", "padding", "barPadding", "dotPadding", "numericalScale", "bandScale", 34 | "title", "description", "setName", "combinationName", "combinationNameAxisOffset", "barLabelOffset", "setNameAxisOffset", 35 | "fontFamily", "fontSizes", "exportButtons", "className", 36 | "theme", "selectionColor", "alternatingBackgroundColor", "color", 37 | "hasSelectionColor", "textColor", "hoverHintColor", "notMemberColor", "valueTextColor", "strokeColor", "opacity", "hasSelectionOpacity", "filled" 38 | ), 39 | package = "upsetjs" 40 | ) 41 | 42 | structure(component, class = c("dash_component", "upsetjs_upset_dash", "upsetjs_common_dash", "list")) 43 | } 44 | 45 | 46 | .dash_upsetjs_js_metadata <- function() { 47 | deps_metadata <- list( 48 | `upsetjs` = structure(list( 49 | name = "upsetjs", 50 | version = "1.9.0", 51 | src = list( 52 | href = NULL, 53 | file = "dash" 54 | ), 55 | meta = NULL, 56 | script = "upsetjs.js", 57 | stylesheet = NULL, 58 | head = NULL, 59 | attachment = NULL, 60 | package = "upsetjs", 61 | all_files = FALSE 62 | ), class = "html_dependency") 63 | ) 64 | return(deps_metadata) 65 | } 66 | -------------------------------------------------------------------------------- /R/data-helpers.R: -------------------------------------------------------------------------------- 1 | # 2 | # @upsetjs/r 3 | # https://github.com/upsetjs/upsetjs_r 4 | # 5 | # Copyright (c) 2021 Samuel Gratzl 6 | # 7 | 8 | sortSets <- function(sets, 9 | order.by = "cardinality", 10 | limit = NULL) { 11 | setAttr <- function(order.by.attr) { 12 | if (order.by.attr == "cardinality") { 13 | sapply(sets, function(x) { 14 | if (length(x$elems) == 0) { 15 | x$cardinality * -1 16 | } else { 17 | length(x$elems) * -1 18 | } 19 | }) 20 | } else if (order.by.attr == "degree") { 21 | sapply(sets, function(x) { 22 | length(x$setNames) 23 | }) 24 | } else { 25 | sapply(sets, function(x) { 26 | x$name 27 | }) 28 | } 29 | } 30 | 31 | if (length(order.by) == 1 && order.by[1] == "cardinality") { 32 | order.by <- c("cardinality", "name") 33 | } else if (length(order.by) == 1 && order.by[1] == "degree") { 34 | order.by <- c("degree", "name") 35 | } 36 | if (length(sets) > 1) { 37 | values <- lapply(order.by, setAttr) 38 | o <- do.call(order, values) 39 | r <- sets[o] 40 | } else { 41 | r <- sets 42 | } 43 | if (is.null(limit) || length(r) <= limit) { 44 | r 45 | } else { 46 | r[1:limit] 47 | } 48 | } 49 | 50 | colorLookup <- function(colors = NULL) { 51 | if (is.null(colors)) { 52 | function(c) { 53 | NULL 54 | } 55 | } else { 56 | colorNames <- names(colors) 57 | function(c) { 58 | if (c %in% colorNames) { 59 | colors[[c]] 60 | } else { 61 | NULL 62 | } 63 | } 64 | } 65 | } 66 | 67 | generateCombinationsImpl <- function(sets, 68 | c_type, 69 | min, 70 | max, 71 | empty, 72 | order.by, 73 | limit, 74 | colors = NULL, 75 | symbol = "&", 76 | store.elems = TRUE) { 77 | combinations <- list() 78 | distinct <- (c_type == "distinctIntersection") 79 | cc <- colorLookup(colors) 80 | 81 | mergeUnion <- function(a, b) { 82 | abSets <- union(a$setNames, b$setNames) 83 | abName <- paste(abSets, collapse = symbol) 84 | abElems <- c() 85 | if (a$cardinality == 0) { 86 | abElems <- b$elems 87 | } else if (b$cardinality == 0) { 88 | abElems <- a$elems 89 | } else { 90 | abElems <- union(a$elems, b$elems) 91 | } 92 | asCombination(abName, abElems, "union", abSets, color = cc(abName)) 93 | } 94 | 95 | mergeIntersect <- function(a, b) { 96 | abSets <- union(a$setNames, b$setNames) 97 | abName <- paste(abSets, collapse = symbol) 98 | abElems <- c() 99 | if (a$cardinality > 0 && b$cardinality > 0) { 100 | abElems <- intersect(a$elems, b$elems) 101 | } 102 | asCombination(abName, abElems, "intersect", abSets, color = cc(abName)) 103 | } 104 | 105 | calc <- ifelse(c_type == "union", mergeUnion, mergeIntersect) 106 | 107 | pushCombination <- function(s) { 108 | if (s$degree < min || (!is.null(max) && s$degree > max) || (s$cardinality == 0 && !empty)) { 109 | return() 110 | } 111 | if (!store.elems) { 112 | s <<- asCombination(s$name, c(), "distinctIntersection", s$setNames, cardinality = s$cardinality, color = s$color) 113 | } 114 | if (!distinct) { 115 | combinations <<- c(combinations, list(s)) 116 | return() 117 | } 118 | otherSets <- Filter(function(ss) { 119 | !(ss$name %in% s$setNames) 120 | }, sets) 121 | 122 | dElems <- s$elems 123 | for (o in otherSets) { 124 | dElems <- setdiff(dElems, o$elems) 125 | } 126 | 127 | if (s$cardinality == length(dElems)) { 128 | combinations <<- c(combinations, list(s)) 129 | return() 130 | } 131 | 132 | sDistinct <- asCombination(s$name, if (store.elems) { 133 | dElems 134 | } else { 135 | c() 136 | }, "distinctIntersection", s$setNames, cardinality = length(dElems), color = s$color) 137 | if (sDistinct$cardinality > 0 || empty) { 138 | combinations <<- c(combinations, list(sDistinct)) 139 | } 140 | } 141 | 142 | generateLevel <- function(arr, degree) { 143 | if (!is.null(max) && degree > max) { 144 | return() 145 | } 146 | l <- length(arr) 147 | for (i in 1:l) { 148 | a <- arr[[i]] 149 | sub <- list() 150 | if (i < l) { 151 | for (j in (i + 1):l) { 152 | b <- arr[[j]] 153 | ab <- calc(a, b) 154 | pushCombination(ab) 155 | if (c_type == "union" || ab$cardinality > 0 || empty) { 156 | sub[[length(sub) + 1]] <- ab 157 | } 158 | } 159 | } 160 | if (length(sub) > 1) { 161 | generateLevel(sub, degree + 1) 162 | } 163 | } 164 | } 165 | 166 | degree1 <- lapply(seq_along(sets), function(i) { 167 | s <- sets[[i]] 168 | sC <- asCombination(s$name, s$elems, c_type, c(s$name), s$cardinality, s$color) 169 | pushCombination(sC) 170 | sC 171 | }) 172 | generateLevel(degree1, 2) 173 | 174 | names(combinations) <- NULL 175 | sortSets(combinations, order.by, limit) 176 | } 177 | 178 | extractCombinationsImpl <- function(df, 179 | sets, 180 | empty, 181 | order.by, 182 | limit = NULL, 183 | colors = NULL, 184 | symbol = "&", 185 | store.elems = TRUE) { 186 | allSetNames <- sapply(seq_along(sets), function(i) sets[[i]]$name) 187 | if (is.list(allSetNames)) { 188 | allSetNames <- unlist(allSetNames) 189 | } 190 | cc <- colorLookup(colors) 191 | 192 | elems <- rownames(df) 193 | 194 | # Calculate combinations names. 195 | # First, translate from 1/0 per set for member or not into the name of each 196 | # set + separating symbol if member, or empty string if not. 197 | translatedSets <- lapply(allSetNames, function(setName) { 198 | # Same as ifelse(df[[setName]] == 1, paste0(setName, symbol), ""), but a lot faster 199 | c("", paste0(setName, symbol))[df[[setName]] + 1] 200 | }) 201 | # Then paste0() these translated names by row 202 | cName <- do.call(paste0, translatedSets) 203 | 204 | dd <- if (store.elems) { 205 | # Calculate members only if we need it 206 | members <- aggregate(elems, list(c_name = cName), function(r) { 207 | r 208 | }) 209 | members$cardinality <- lengths(members$x) 210 | members 211 | } else { 212 | # ... otherwise just count cardinality 213 | counts <- table(cName) 214 | data.frame( 215 | c_name = names(counts), 216 | cardinality = as.integer(counts) 217 | ) 218 | } 219 | 220 | setNames <- strsplit(dd$c_name, symbol, fixed = TRUE) 221 | # We got an extra symbol with the translatedSets above; clean it up 222 | dd$c_name <- vapply(setNames, paste0, collapse = symbol, character(1)) 223 | setColors <- cc(dd$c_name) 224 | 225 | combinations <- lapply(seq_len(nrow(dd)), function(i) { 226 | structure( 227 | list( 228 | name = dd[i, "c_name"], 229 | color = setColors[i], 230 | type = "distinctIntersection", 231 | elems = if (store.elems) as.character(dd[[i, "x"]]) else c(), 232 | setNames = setNames[i][[1]], 233 | cardinality = dd[i, "cardinality"] 234 | ), 235 | class = "upsetjs_combination" 236 | ) 237 | }) 238 | names(combinations) <- NULL 239 | sortSets(combinations, order.by, limit) 240 | } 241 | -------------------------------------------------------------------------------- /R/data.R: -------------------------------------------------------------------------------- 1 | # 2 | # @upsetjs/r 3 | # https://github.com/upsetjs/upsetjs_r 4 | # 5 | # Copyright (c) 2021 Samuel Gratzl 6 | # 7 | 8 | #' 9 | #' creates a new UpSet set structure 10 | #' @param name name of the set 11 | #' @param elems the elements of the set 12 | #' @param cardinality the cardinality of the set, default to `length(elems)` 13 | #' @param color the color of the set 14 | #' @return the set object 15 | #' @examples 16 | #' asSet("a", c(1, 2, 3)) 17 | #' @export 18 | asSet <- function(name, elems = c(), cardinality = length(elems), color = NULL) { 19 | structure(list( 20 | name = name, 21 | type = "set", 22 | elems = elems, 23 | cardinality = cardinality, 24 | color = color 25 | ), 26 | class = "upsetjs_set" 27 | ) 28 | } 29 | 30 | #' 31 | #' creates a new UpSet set combination structure 32 | #' @param name name of the set combination 33 | #' @param elems the elements of the set combination 34 | #' @param type the set combination type (intersection,distinctIntersection,union,combination) 35 | #' @param sets the sets this combination is part of 36 | #' @param cardinality the cardinality of the set, default to `length(elems)` 37 | #' @param color the color of the set 38 | #' @return the set object 39 | #' @examples 40 | #' asCombination("a", c(1, 2, 3)) 41 | #' @export 42 | asCombination <- function(name, elems = c(), type = "intersection", 43 | sets = strsplit(name, "&"), cardinality = length(elems), color = NULL) { 44 | structure( 45 | list( 46 | name = name, 47 | type = type, 48 | elems = elems, 49 | color = color, 50 | cardinality = cardinality, 51 | setNames = sets, 52 | degree = length(sets) 53 | ), 54 | class = "upsetjs_combination" 55 | ) 56 | } 57 | 58 | #' 59 | #' generates the sets from a lists object 60 | #' @param upsetjs an object of class \code{upsetjs} or \code{upsetjs_proxy} 61 | #' @param value the list input value 62 | #' @param order.by order intersections by cardinality or name 63 | #' @param limit limit the ordered sets to the given limit 64 | #' @param shared a crosstalk shared data frame 65 | #' @param shared.mode whether on 'hover' or 'click' (default) is synced 66 | #' @param colors the optional list with set name to color 67 | #' @param c_type the combination type to use or "none" for disabling initial generation 68 | #' @return the object given as first argument 69 | #' @examples 70 | #' upsetjs() %>% fromList(list(a = c(1, 2, 3), b = c(2, 3))) 71 | #' @export 72 | fromList <- function(upsetjs, 73 | value, 74 | order.by = "cardinality", 75 | limit = NULL, 76 | shared = NULL, 77 | shared.mode = "click", 78 | colors = NULL, 79 | c_type = NULL) { 80 | checkUpSetCommonArgument(upsetjs) 81 | stopifnot(is.list(value)) 82 | stopifnot(order.by == "cardinality" || order.by == "degree") 83 | stopifnot(is.null(limit) || 84 | (is.numeric(limit) && length(limit) == 1)) 85 | stopifnot(shared.mode == "click" || shared.mode == "hover") 86 | stopifnot(is.null(colors) || is.list(colors)) 87 | stopifnot( 88 | is.null(c_type) || 89 | c_type == "intersection" || 90 | c_type == "union" || c_type == "distinctIntersection" || 91 | c_type == "none" 92 | ) 93 | 94 | elems <- c() 95 | cc <- colorLookup(colors) 96 | toSet <- function(key, value) { 97 | elems <<- unique(c(elems, value)) 98 | asSet(key, value, color = cc(key)) 99 | } 100 | sets <- mapply(toSet, 101 | key = names(value), 102 | value = value, 103 | SIMPLIFY = FALSE 104 | ) 105 | # list of list objects 106 | names(sets) <- NULL 107 | names(elems) <- NULL 108 | 109 | if (!is.null(shared)) { 110 | upsetjs <- enableCrosstalk(upsetjs, shared, mode = shared.mode) 111 | } 112 | 113 | sortedSets <- sortSets(sets, order.by = order.by, limit = limit) 114 | 115 | gen <- if (!is.null(c_type) && c_type == "none") { 116 | list() 117 | } else if (isVennDiagram(upsetjs) || isKarnaughMap(upsetjs)) { 118 | generateCombinationsImpl( 119 | sortedSets, 120 | ifelse(is.null(c_type), "distinctIntersection", c_type), 121 | 0, 122 | NULL, 123 | TRUE, 124 | "degree", 125 | limit, 126 | colors 127 | ) 128 | } else { 129 | generateCombinationsImpl( 130 | sortedSets, 131 | ifelse(is.null(c_type), "intersection", c_type), 132 | 0, 133 | NULL, 134 | FALSE, 135 | order.by, 136 | limit, 137 | colors 138 | ) 139 | } 140 | setProperties( 141 | upsetjs, 142 | list( 143 | sets = sortedSets, 144 | combinations = gen, 145 | elems = elems, 146 | expressionData = FALSE, 147 | attrs = list() 148 | ) 149 | ) 150 | } 151 | 152 | #' 153 | #' generates the sets from a lists object that contained the cardinalities of both sets and combinations (&) 154 | #' @param upsetjs an object of class \code{upsetjs} or \code{upsetjs_proxy} 155 | #' @param value the expression list input 156 | #' @param symbol the symbol how to split list names to get the sets 157 | #' @param order.by order intersections by cardinality or name 158 | #' @param colors the optional list with set name to color 159 | #' @param type the type of intersections this data represents (intersection,union,distinctIntersection) 160 | #' @return the object given as first argument 161 | #' @examples 162 | #' upsetjs() %>% fromExpression(list(a = 3, b = 2, `a&b` = 2)) 163 | #' @export 164 | fromExpression <- function(upsetjs, 165 | value, 166 | symbol = "&", 167 | order.by = "cardinality", 168 | colors = NULL, 169 | type = "intersection") { 170 | checkUpSetCommonArgument(upsetjs) 171 | stopifnot(is.list(value)) 172 | stopifnot(order.by == "cardinality" || order.by == "degree") 173 | stopifnot(is.null(colors) || is.list(colors)) 174 | stopifnot(type == "intersection" || 175 | type == "union" || type == "distinctIntersection") 176 | 177 | cc <- colorLookup(colors) 178 | 179 | degrees <- sapply(names(value), function(x) { 180 | length(unlist(strsplit(x, symbol))) 181 | }) 182 | 183 | rawCombinations <- value 184 | 185 | toCombination <- function(key, value, color) { 186 | asCombination(key, c(), type, sets = unlist(strsplit(key, symbol)), cardinality = value, color = cc(key)) 187 | } 188 | combinations <- mapply( 189 | toCombination, 190 | key = names(rawCombinations), 191 | value = rawCombinations, 192 | SIMPLIFY = FALSE 193 | ) 194 | names(combinations) <- NULL 195 | combinations <- sortSets(combinations, order.by = order.by) 196 | 197 | sets <- list() 198 | definedSets <- c() 199 | for (c in combinations) { 200 | for (s in c$setNames) { 201 | if (!(s %in% definedSets)) { 202 | definedSets <- c(definedSets, s) 203 | sets[[s]] <- asSet(s, c(), color = cc(s)) 204 | } 205 | # determine base set based on type and value 206 | set <- sets[[s]] 207 | if (type == "distinctIntersection") { 208 | set$cardinality <- set$cardinality + c$cardinality 209 | } else if (length(c$setNames) == 1) { 210 | set$cardinality <- c$cardinality 211 | } else if (type == "intersection") { 212 | set$cardinality <- max(set$cardinality, c$cardinality) 213 | } else if (type == "union") { 214 | set$cardinality <- min(set$cardinality, c$cardinality) 215 | } 216 | sets[[s]] <- set 217 | } 218 | } 219 | names(sets) <- NULL 220 | sets <- sortSets(sets, order.by = order.by) 221 | 222 | 223 | props <- list( 224 | sets = sets, 225 | combinations = combinations, 226 | elems = c(), 227 | attrs = list(), 228 | expressionData = TRUE 229 | ) 230 | setProperties(upsetjs, props) 231 | } 232 | 233 | #' 234 | #' extract the sets from a data frame (rows = elems, columns = sets, cell = contained) 235 | #' @param df the data.frame like structure 236 | #' @param attributes the optional column list or data frame 237 | #' @param order.by order intersections by cardinality or degree 238 | #' @param limit limit the ordered sets to the given limit 239 | #' @param colors the optional list with set name to color 240 | #' @param store.elems store the elements in the sets (default TRUE) 241 | #' @export 242 | extractSetsFromDataFrame <- function(df, 243 | attributes = NULL, 244 | order.by = "cardinality", 245 | limit = NULL, 246 | colors = NULL, 247 | store.elems = TRUE) { 248 | stopifnot(is.data.frame(df)) 249 | stopifnot(( 250 | is.null(attributes) || 251 | is.data.frame(attributes) || 252 | is.list(attributes) || is.character(attributes) 253 | )) 254 | stopifnot(order.by == "cardinality" || order.by == "degree") 255 | stopIfNotType("limit", limit) 256 | stopifnot(is.null(colors) || is.list(colors)) 257 | 258 | cc <- colorLookup(colors) 259 | 260 | elems <- rownames(df) 261 | 262 | toSet <- function(key) { 263 | sub <- elems[df[[key]] == TRUE] 264 | x <- if (store.elems) sub else c() 265 | asSet(key, x, cardinality = length(sub), color = cc(key)) 266 | } 267 | 268 | setNames <- setdiff(colnames(df), if (is.character(attributes)) { 269 | attributes 270 | } else { 271 | c() 272 | }) 273 | sets <- lapply(setNames, toSet) 274 | 275 | sortSets(sets, order.by = order.by, limit = limit) 276 | } 277 | 278 | #' 279 | #' extract the sets from a data frame (rows = elems, columns = sets, cell = contained) 280 | #' @param upsetjs an object of class \code{upsetjs} or \code{upsetjs_proxy} 281 | #' @param df the data.frame like structure 282 | #' @param attributes the optional column list or data frame 283 | #' @param order.by order intersections by cardinality or degree 284 | #' @param limit limit the ordered sets to the given limit 285 | #' @param shared a crosstalk shared data frame 286 | #' @param shared.mode whether on 'hover' or 'click' (default) is synced 287 | #' @param colors the optional list with set name to color 288 | #' @param c_type the combination type to use 289 | #' @param store.elems whether to store the set elements within the structures (set to false for big data frames) 290 | #' @return the object given as first argument 291 | #' @importFrom stats aggregate 292 | #' @examples 293 | #' df <- as.data.frame(list(a = c(1, 1, 1), b = c(0, 1, 1)), row.names = c("a", "b", "c")) 294 | #' upsetjs() %>% fromDataFrame(df) 295 | #' @export 296 | fromDataFrame <- function(upsetjs, 297 | df, 298 | attributes = NULL, 299 | order.by = "cardinality", 300 | limit = NULL, 301 | shared = NULL, 302 | shared.mode = "click", 303 | colors = NULL, 304 | c_type = NULL, 305 | store.elems = TRUE) { 306 | checkUpSetCommonArgument(upsetjs) 307 | stopifnot(is.data.frame(df)) 308 | stopifnot(( 309 | is.null(attributes) || 310 | is.data.frame(attributes) || 311 | is.list(attributes) || is.character(attributes) 312 | )) 313 | stopifnot(order.by == "cardinality" || order.by == "degree") 314 | stopIfNotType("limit", limit) 315 | stopifnot(shared.mode == "click" || shared.mode == "hover") 316 | stopifnot(is.null(colors) || is.list(colors)) 317 | stopifnot( 318 | is.null(c_type) || 319 | c_type == "intersection" || 320 | c_type == "union" || c_type == "distinctIntersection" || 321 | c_type == "none" 322 | ) 323 | 324 | genType <- ifelse(!is.null(c_type), c_type, ifelse(isVennDiagram(upsetjs) || isKarnaughMap(upsetjs), "distinctIntersection", "intersection")) 325 | sortedSets <- extractSetsFromDataFrame(df, attributes, order.by, limit, 326 | colors, 327 | store.elems = store.elems || genType != "distinctIntersection" 328 | ) 329 | 330 | elems <- rownames(df) 331 | 332 | gen <- if (!is.null(c_type) && c_type == "none") { 333 | list() 334 | } else if (isVennDiagram(upsetjs) || isKarnaughMap(upsetjs)) { 335 | if (genType == "distinctIntersection") { 336 | extractCombinationsImpl( 337 | df, 338 | sortedSets, 339 | TRUE, 340 | order.by, 341 | limit, 342 | colors, 343 | store.elems = store.elems 344 | ) 345 | } else { 346 | generateCombinationsImpl( 347 | sortedSets, 348 | genType, 349 | 0, 350 | NULL, 351 | TRUE, 352 | "degree", 353 | limit, 354 | colors, 355 | store.elems = store.elems 356 | ) 357 | } 358 | } else if (genType == "distinctIntersection") { 359 | extractCombinationsImpl( 360 | df, 361 | sortedSets, 362 | FALSE, 363 | order.by, 364 | limit, 365 | colors, 366 | store.elems = store.elems 367 | ) 368 | } else { 369 | generateCombinationsImpl( 370 | sortedSets, 371 | genType, 372 | 0, 373 | NULL, 374 | FALSE, 375 | order.by, 376 | limit, 377 | colors, 378 | store.elems = store.elems 379 | ) 380 | } 381 | 382 | if (!store.elems && genType != "distinctIntersection") { 383 | # delete 384 | for (i in seq_along(sortedSets)) { 385 | sortedSets[[i]]$elems <- c() 386 | } 387 | } 388 | 389 | props <- list( 390 | sets = sortedSets, 391 | combinations = gen, 392 | elems = elems, 393 | expressionData = FALSE 394 | ) 395 | 396 | upsetjs <- setProperties(upsetjs, props) 397 | 398 | if (!is.null(attributes)) { 399 | attrDf <- if (is.character(attributes)) { 400 | df[, attributes] 401 | } else { 402 | attributes 403 | } 404 | upsetjs <- setAttributes(upsetjs, attrDf) 405 | } 406 | 407 | if (!is.null(shared)) { 408 | upsetjs <- enableCrosstalk(upsetjs, shared, mode = shared.mode) 409 | } else { 410 | upsetjs <- enableCrosstalk(upsetjs, df, mode = shared.mode) 411 | } 412 | 413 | upsetjs 414 | } 415 | 416 | #' 417 | #' extract the vector of elements 418 | #' @param upsetjs an object of class \code{upsetjs} or \code{upsetjs_proxy} 419 | #' @return vector of elements 420 | #' @examples 421 | #' upsetjs() %>% 422 | #' fromList(list(a = c(1, 2, 3), b = c(2, 3))) %>% 423 | #' getElements() 424 | #' @export 425 | getElements <- function(upsetjs) { 426 | stopifnot(inherits(upsetjs, c("upsetjs_common", "upsetjs_common_dash"))) 427 | if (inherits(upsetjs, "upsetjs_common")) { 428 | upsetjs$x$elems 429 | } else { 430 | upsetjs$props$elems 431 | } 432 | } 433 | 434 | #' 435 | #' set the vector of elements 436 | #' @param upsetjs an object of class \code{upsetjs} 437 | #' @param value the vector of elements 438 | #' @return the object given as first argument 439 | #' @examples 440 | #' upsetjs() %>% 441 | #' setElements(c(1, 2, 3, 4, 5)) %>% 442 | #' getElements() 443 | #' @export 444 | setElements <- function(upsetjs, value) { 445 | stopifnot(inherits(upsetjs, c("upsetjs_common", "upsetjs_common_dash"))) 446 | setProperty(upsetjs, "elems", value) 447 | } 448 | 449 | #' 450 | #' extract the vector of sets 451 | #' @param upsetjs an object of class \code{upsetjs} 452 | #' @return vector of sets 453 | #' @examples 454 | #' upsetjs() %>% 455 | #' fromList(list(a = c(1, 2, 3), b = c(2, 3))) %>% 456 | #' getSets() 457 | #' @export 458 | getSets <- function(upsetjs) { 459 | stopifnot(inherits(upsetjs, c("upsetjs_common", "upsetjs_common_dash"))) 460 | if (inherits(upsetjs, "upsetjs_common")) { 461 | upsetjs$x$sets 462 | } else { 463 | upsetjs$props$sets 464 | } 465 | } 466 | 467 | #' 468 | #' set the vector of sets 469 | #' @param upsetjs an object of class \code{upsetjs} 470 | #' @param value the vector of sets 471 | #' @return the object given as first argument 472 | #' @examples 473 | #' upsetjs() %>% 474 | #' setCombinations(list(asSet("a", c(1, 2, 3)))) %>% 475 | #' getSets() 476 | #' @export 477 | setSets <- function(upsetjs, value) { 478 | stopifnot(inherits(upsetjs, c("upsetjs_common", "upsetjs_common_dash"))) 479 | setProperty(upsetjs, "sets", value) 480 | } 481 | 482 | #' 483 | #' extract the vector of combinations 484 | #' @param upsetjs an object of class \code{upsetjs} 485 | #' @return vector of sets 486 | #' @examples 487 | #' upsetjs() %>% 488 | #' fromList(list(a = c(1, 2, 3), b = c(2, 3))) %>% 489 | #' getCombinations() 490 | #' @export 491 | getCombinations <- function(upsetjs) { 492 | stopifnot(inherits(upsetjs, c("upsetjs_common", "upsetjs_common_dash"))) 493 | if (inherits(upsetjs, "upsetjs_common")) { 494 | upsetjs$x$combinations 495 | } else { 496 | upsetjs$props$combinations 497 | } 498 | } 499 | 500 | #' 501 | #' set the vector of combinations 502 | #' @param upsetjs an object of class \code{upsetjs} 503 | #' @param value the vector of combinations 504 | #' @return the object given as first argument 505 | #' @examples 506 | #' upsetjs() %>% 507 | #' setCombinations(list(asCombination("a", c(1, 2, 3)))) %>% 508 | #' getCombinations() 509 | #' @export 510 | setCombinations <- function(upsetjs, value) { 511 | stopifnot(inherits(upsetjs, c("upsetjs_common", "upsetjs_common_dash"))) 512 | setProperty(upsetjs, "combinations", value) 513 | } 514 | 515 | generateCombinations <- function(upsetjs, 516 | c_type, 517 | min, 518 | max, 519 | empty, 520 | order.by, 521 | limit, 522 | colors = NULL, 523 | symbol = "&") { 524 | checkUpSetArgument(upsetjs) 525 | stopifnot(is.numeric(min), length(min) == 1) 526 | stopIfNotType("max", max) 527 | stopifnot(is.logical(empty), length(empty) == 1) 528 | stopifnot(is.character(order.by), length(order.by) >= 1) 529 | stopifnot(is.null(limit) || 530 | (is.numeric(limit) && length(limit) == 1)) 531 | stopifnot(is.null(colors) || is.list(colors)) 532 | stopifnot(c_type == "intersection" || 533 | c_type == "union" || c_type == "distinctIntersection") 534 | 535 | if (inherits(upsetjs, "upsetjs_common")) { 536 | sets <- upsetjs$x$sets 537 | gen <- generateCombinationsImpl(sets, c_type, min, max, empty, order.by, limit, colors, symbol) 538 | } else if (inherits(upsetjs, "upsetjs_common_dash")) { 539 | sets <- upsetjs$props$sets 540 | gen <- generateCombinationsImpl(sets, c_type, min, max, empty, order.by, limit, colors, symbol) 541 | } else { 542 | # proxy 543 | gen <- cleanNull(list( 544 | type = c_type, 545 | min = min, 546 | max = max, 547 | empty = empty, 548 | order = order.by, 549 | limit = limit 550 | )) 551 | } 552 | setProperty(upsetjs, "combinations", gen) 553 | } 554 | 555 | #' 556 | #' configure the generation of the intersections 557 | #' @param upsetjs an object of class \code{upsetjs} or \code{upsetjs_proxy} 558 | #' @param min minimum number of sets in an intersection 559 | #' @param max maximum number of sets in an intersection 560 | #' @param empty whether to include empty intersections or not 561 | #' @param order.by order intersections by cardinality, degree, name or a combination of it 562 | #' @param limit limit the number of intersections to the top N 563 | #' @param colors the optional list with set name to color 564 | #' @return the object given as first argument 565 | #' @examples 566 | #' upsetjs() %>% 567 | #' fromList(list(a = c(1, 2, 3), b = c(2, 3))) %>% 568 | #' generateIntersections(min = 2) 569 | #' @export 570 | generateIntersections <- function(upsetjs, 571 | min = 0, 572 | max = NULL, 573 | empty = FALSE, 574 | order.by = "cardinality", 575 | limit = NULL, 576 | colors = NULL) { 577 | generateCombinations( 578 | upsetjs, 579 | "intersection", 580 | min, 581 | max, 582 | empty, 583 | order.by, 584 | limit, 585 | colors 586 | ) 587 | } 588 | 589 | #' 590 | #' configure the generation of the distinct intersections 591 | #' @param upsetjs an object of class \code{upsetjs} or \code{upsetjs_proxy} 592 | #' @param min minimum number of sets in an intersection 593 | #' @param max maximum number of sets in an intersection 594 | #' @param empty whether to include empty intersections or not 595 | #' @param order.by order intersections by cardinality, degree, name or a combination of it 596 | #' @param limit limit the number of intersections to the top N 597 | #' @param colors the optional list with set name to color 598 | #' @return the object given as first argument 599 | #' @examples 600 | #' upsetjs() %>% 601 | #' fromList(list(a = c(1, 2, 3), b = c(2, 3))) %>% 602 | #' generateDistinctIntersections(min = 2) 603 | #' @export 604 | generateDistinctIntersections <- function(upsetjs, 605 | min = 0, 606 | max = NULL, 607 | empty = FALSE, 608 | order.by = "cardinality", 609 | limit = NULL, 610 | colors = NULL) { 611 | generateCombinations( 612 | upsetjs, 613 | "distinctIntersection", 614 | min, 615 | max, 616 | empty, 617 | order.by, 618 | limit, 619 | colors 620 | ) 621 | } 622 | 623 | #' 624 | #' configure the generation of the unions 625 | #' @param upsetjs an object of class \code{upsetjs} or \code{upsetjs_proxy} 626 | #' @param min minimum number of sets in an union 627 | #' @param max maximum number of sets in an union 628 | #' @param empty whether to include empty intersections or not 629 | #' @param order.by order intersections by cardinality, degree, name or a combination of it 630 | #' @param limit limit the number of intersections to the top N 631 | #' @param colors the optional list with set name to color 632 | #' @return the object given as first argument 633 | #' @examples 634 | #' upsetjs() %>% 635 | #' fromList(list(a = c(1, 2, 3), b = c(2, 3))) %>% 636 | #' generateUnions() 637 | #' @export 638 | generateUnions <- function(upsetjs, 639 | min = 0, 640 | max = NULL, 641 | empty = FALSE, 642 | order.by = "cardinality", 643 | limit = NULL, 644 | colors = NULL) { 645 | generateCombinations(upsetjs, "union", min, max, empty, order.by, limit, colors) 646 | } 647 | -------------------------------------------------------------------------------- /R/got.R: -------------------------------------------------------------------------------- 1 | # 2 | # @upsetjs/r 3 | # https://github.com/upsetjs/upsetjs_r 4 | # 5 | # Copyright (c) 2021 Samuel Gratzl 6 | # 7 | 8 | #' Games of Thrones Character dataset for UpSet.js 9 | #' 10 | #' A dataset containing set information about Game of Thrones characters 11 | #' 12 | #' @format A data frame with 22 rows and 6 variables/sets: 13 | #' \describe{ 14 | #' \item{Lannister}{character part of the Lannister house} 15 | #' \item{Stark}{character part of the Start house} 16 | #' \item{female}{character is female} 17 | #' \item{male}{character is male} 18 | #' \item{royal}{character is royal} 19 | #' \item{was.killed}{character was killed} 20 | #' } 21 | #' @source \url{https://github.com/jeffreylancaster/game-of-thrones} 22 | "got" 23 | -------------------------------------------------------------------------------- /R/queries.R: -------------------------------------------------------------------------------- 1 | # 2 | # @upsetjs/r 3 | # https://github.com/upsetjs/upsetjs_r 4 | # 5 | # Copyright (c) 2021 Samuel Gratzl 6 | # 7 | 8 | 9 | 10 | #' 11 | #' set the queries 12 | #' @param upsetjs an object of class \code{upsetjs} or \code{upsetjs_proxy} 13 | #' @param queries the queries to set 14 | #' @return the object given as first argument 15 | #' @examples 16 | #' upsetjs() %>% 17 | #' fromList(list(a = c(1, 2, 3), b = c(2, 3))) %>% 18 | #' setQueries(list(list(name = "Q1", color = "red", set = "b"))) 19 | #' @export 20 | setQueries <- function(upsetjs, queries = list()) { 21 | checkUpSetCommonArgument(upsetjs) 22 | stopifnot(is.list(queries)) 23 | setProperty(upsetjs, "queries", queries) 24 | } 25 | 26 | #' 27 | #' adds a new query to the plot 28 | #' @param upsetjs an object of class \code{upsetjs} or \code{upsetjs_proxy} 29 | #' @param name name of the query 30 | #' @param color color of the query 31 | #' @param elems the list of elems to highlight 32 | #' @param set the set name, similar to the selection 33 | #' @return the object given as first argument 34 | #' @examples 35 | #' upsetjs() %>% 36 | #' fromList(list(a = c(1, 2, 3), b = c(2, 3))) %>% 37 | #' addQuery(name = "Q1", color = "red", set = "b") 38 | #' @export 39 | addQuery <- function(upsetjs, 40 | name, 41 | color, 42 | elems = NULL, 43 | set = NULL) { 44 | checkUpSetCommonArgument(upsetjs) 45 | stopifnot(is.character(name), length(name) == 1) 46 | stopifnot(is.character(color), length(color) == 1) 47 | stopifnot((is.character(set) && 48 | length(set) >= 1) || is.vector(elems)) 49 | 50 | appendProperty(upsetjs, "queries", cleanNull(list( 51 | name = name, 52 | color = color, 53 | elems = elems, 54 | set = set 55 | ))) 56 | } 57 | 58 | 59 | #' 60 | #' clears the list of queries for incremental updates 61 | #' @param upsetjs an object of class \code{upsetjs} or \code{upsetjs_proxy} 62 | #' @return the object given as first argument 63 | #' @examples 64 | #' upsetjs() %>% 65 | #' fromList(list(a = c(1, 2, 3), b = c(2, 3))) %>% 66 | #' addQuery(name = "Q1", color = "red", set = "b") %>% 67 | #' clearQueries() 68 | #' @export 69 | clearQueries <- function(upsetjs) { 70 | checkUpSetCommonArgument(upsetjs) 71 | 72 | setProperty(upsetjs, "queries", NULL) 73 | } 74 | 75 | 76 | #' 77 | #' renders a legend for the queries 78 | #' @param upsetjs an object of class \code{upsetjs} or \code{upsetjs_proxy} 79 | #' @param value whether to enable or disable 80 | #' @return the object given as first argument 81 | #' @examples 82 | #' upsetjs() %>% 83 | #' fromList(list(a = c(1, 2, 3), b = c(2, 3))) %>% 84 | #' addQuery(name = "Q1", color = "red", set = "b") %>% 85 | #' queryLegend(FALSE) 86 | #' @export 87 | queryLegend <- function(upsetjs, value = TRUE) { 88 | checkUpSetCommonArgument(upsetjs) 89 | stopifnot(is.logical(value), length(value) == 1) 90 | 91 | setProperty(upsetjs, "queryLegend", value) 92 | } 93 | -------------------------------------------------------------------------------- /R/reexport.R: -------------------------------------------------------------------------------- 1 | # 2 | # @upsetjs/r 3 | # https://github.com/upsetjs/upsetjs_r 4 | # 5 | # Copyright (c) 2021 Samuel Gratzl 6 | # 7 | 8 | 9 | #' @importFrom magrittr %>% 10 | #' @export 11 | magrittr::`%>%` 12 | -------------------------------------------------------------------------------- /R/selection.R: -------------------------------------------------------------------------------- 1 | # 2 | # @upsetjs/r 3 | # https://github.com/upsetjs/upsetjs_r 4 | # 5 | # Copyright (c) 2021 Samuel Gratzl 6 | # 7 | 8 | 9 | 10 | #' 11 | #' sets the selection of the chart 12 | #' @param upsetjs an object of class \code{upsetjs} or \code{upsetjs_proxy} 13 | #' @param name the name of the set to select or a list with name and type 14 | #' @return the object given as first argument 15 | #' @examples 16 | #' upsetjs() %>% 17 | #' fromList(list(a = c(1, 2, 3), b = c(2, 3))) %>% 18 | #' setSelection("b") 19 | #' @export 20 | setSelection <- function(upsetjs, name = NULL) { 21 | checkUpSetCommonArgument(upsetjs) 22 | stopifnot(is.null(name) || 23 | (is.character(name) && length(name) >= 1) || 24 | (is.list(name) && "name" %in% names(name) && "type" %in% names(name))) 25 | 26 | # NULL won't be transmitted 27 | if (is.null(name)) { 28 | setProperty(upsetjs, "selection", "") 29 | } else { 30 | setProperty(upsetjs, "selection", name) 31 | } 32 | } 33 | 34 | #' 35 | #' make it an interactive chart 36 | #' @param upsetjs an object of class \code{upsetjs} or \code{upsetjs_proxy} 37 | #' @param value whether to enable or disable or set the mode: hover, click, contextMenu 38 | #' @param events_nonce whether to enable send a unique once (event date) for each event to prevent deduplication 39 | #' @return the object given as first argument 40 | #' @examples 41 | #' upsetjs() %>% 42 | #' fromList(list(a = c(1, 2, 3), b = c(2, 3))) %>% 43 | #' interactiveChart() 44 | #' @export 45 | interactiveChart <- function(upsetjs, value = TRUE, events_nonce = FALSE) { 46 | checkUpSetCommonArgument(upsetjs) 47 | stopifnot(is.logical(value) || (value %in% c("hover", "click", "contextMenu")), length(value) == 1) 48 | 49 | setProperties( 50 | upsetjs, 51 | list( 52 | interactive = value, 53 | events_nonce = events_nonce 54 | ) 55 | ) 56 | } 57 | -------------------------------------------------------------------------------- /R/shiny.R: -------------------------------------------------------------------------------- 1 | # 2 | # @upsetjs/r 3 | # https://github.com/upsetjs/upsetjs_r 4 | # 5 | # Copyright (c) 2021 Samuel Gratzl 6 | # 7 | 8 | 9 | #' Output and render functions for using UpSet.js within Shiny 10 | #' applications and interactive Rmd documents. 11 | #' 12 | #' @param outputId output variable to read from 13 | #' @param width Must be a valid CSS unit (like \code{'100\%'}, 14 | #' \code{'800px'}, \code{'auto'}) or a number, which will be coerced to a 15 | #' string and have \code{'px'} appended. 16 | #' @param height see width 17 | #' @importFrom htmlwidgets shinyWidgetOutput 18 | #' @return An output or render function that enables the use of the widget 19 | #' within Shiny applications. 20 | #' 21 | #' @export 22 | upsetjsOutput <- function(outputId, 23 | width = "100%", 24 | height = "400px") { 25 | htmlwidgets::shinyWidgetOutput(outputId, "upsetjs", width, height, "upsetjs") 26 | } 27 | 28 | #' Shiny render bindings for upsetjs 29 | #' 30 | #' @param expr An expression that generates an upset 31 | #' @param env The environment in which to evaluate \code{expr}. 32 | #' @param quoted Is \code{expr} a quoted expression (with \code{quote()})? This 33 | #' is useful if you want to save an expression in a variable. 34 | #' @importFrom htmlwidgets shinyRenderWidget 35 | #' @return The output of shinyRenderWidget function 36 | #' 37 | #' @export 38 | renderUpsetjs <- function(expr, 39 | env = parent.frame(), 40 | quoted = FALSE) { 41 | if (!quoted) { 42 | expr <- substitute(expr) 43 | } # force quoted 44 | htmlwidgets::shinyRenderWidget(expr, upsetjsOutput, env, quoted = TRUE) 45 | } 46 | -------------------------------------------------------------------------------- /R/style.R: -------------------------------------------------------------------------------- 1 | # 2 | # @upsetjs/r 3 | # https://github.com/upsetjs/upsetjs_r 4 | # 5 | # Copyright (c) 2021 Samuel Gratzl 6 | # 7 | 8 | 9 | #' 10 | #' specify the chart layout 11 | #' @param upsetjs an object of class \code{upsetjs} or \code{upsetjs_proxy} 12 | #' @param height.ratios a vector of length 2 for the ratios between the combination and set plot, e.g. c(0.6, 0.4) 13 | #' @param width.ratios a vector of length 3 for the ratios between set, label, and combination plot, e.g. c(0.3,0.2,0.5) 14 | #' @param padding padding around the plot 15 | #' @param bar.padding padding ratio (default 0.1) for the bar charts 16 | #' @param dot.padding padding factor (default 0.7) for the dots 17 | #' @param numerical.scale numerical scale: linear (default) or log 18 | #' @param band.scale band scale: band (default) 19 | #' @param set.label.alignment set label alignment: left, center (default), right 20 | #' @param set.max.scale maximum value for the set scale 21 | #' @param combination.max.scale maximum value for the combination scale 22 | #' @return the object given as first argument 23 | #' @examples 24 | #' upsetjs() %>% 25 | #' fromList(list(a = c(1, 2, 3), b = c(2, 3))) %>% 26 | #' chartLayout(width.ratios = c(0.4, 0.2, 0.4)) 27 | #' @export 28 | chartLayout <- function(upsetjs, 29 | height.ratios = NULL, 30 | width.ratios = NULL, 31 | padding = NULL, 32 | bar.padding = NULL, 33 | dot.padding = NULL, 34 | numerical.scale = NULL, 35 | band.scale = NULL, 36 | set.label.alignment = NULL, 37 | set.max.scale = NULL, 38 | combination.max.scale = NULL) { 39 | checkUpSetArgument(upsetjs) 40 | stopifnot(is.null(height.ratios) || 41 | (is.numeric(height.ratios) && 42 | length(height.ratios) == 2)) 43 | stopifnot(is.null(width.ratios) || 44 | (is.numeric(width.ratios) && 45 | length(width.ratios) == 3)) 46 | stopIfNotType("padding", padding) 47 | stopIfNotType("bar.padding", bar.padding) 48 | stopIfNotType("dot.padding", dot.padding) 49 | stopIfNotType("set.max.scale", set.max.scale) 50 | stopIfNotType("combination.max.scale", combination.max.scale) 51 | stopifnot( 52 | is.null(numerical.scale) || 53 | (numerical.scale == "linear" || numerical.scale == "log") 54 | ) 55 | stopifnot(is.null(band.scale) || band.scale == "band") 56 | stopifnot(is.null(set.label.alignment) || set.label.alignment %in% c("left", "center", "right")) 57 | 58 | 59 | props <- list( 60 | heightRatios = height.ratios, 61 | widthRatios = width.ratios, 62 | padding = padding, 63 | barPadding = bar.padding, 64 | dotPadding = dot.padding, 65 | numericalScale = numerical.scale, 66 | bandScale = band.scale, 67 | setLabelAlignment = set.label.alignment, 68 | setMaxScale = set.max.scale, 69 | combinationMaxScale = combination.max.scale 70 | ) 71 | setProperties(upsetjs, props, clean = TRUE) 72 | } 73 | 74 | #' 75 | #' specify the chart venn layout 76 | #' @param upsetjs an object of class \code{upsetjs_venn} or \code{upsetjs_venn_proxy} 77 | #' @param padding padding around the plot 78 | #' @return the object given as first argument 79 | #' @examples 80 | #' upsetjsVennDiagram() %>% 81 | #' fromList(list(a = c(1, 2, 3), b = c(2, 3))) %>% 82 | #' chartVennLayout(padding = 10) 83 | #' @export 84 | chartVennLayout <- function(upsetjs, 85 | padding = NULL) { 86 | checkVennDiagramArgument(upsetjs) 87 | stopIfNotType("padding", padding) 88 | 89 | props <- list(padding = padding) 90 | setProperties(upsetjs, props, clean = TRUE) 91 | } 92 | 93 | #' 94 | #' specify the chart karnaugh map layout 95 | #' @param upsetjs an object of class \code{upsetjs_kmap} or \code{upsetjs_kmap_proxy} 96 | #' @param padding padding around the plot 97 | #' @param numerical.scale numerical scale: linear (default) or log 98 | #' @param bar.padding padding ratio (default 0.1) for the bar charts 99 | #' @return the object given as first argument 100 | #' @examples 101 | #' upsetjsKarnaughMap() %>% 102 | #' fromList(list(a = c(1, 2, 3), b = c(2, 3))) %>% 103 | #' chartKarnaughMapLayout(padding = 10) 104 | #' @export 105 | chartKarnaughMapLayout <- function(upsetjs, 106 | padding = NULL, 107 | bar.padding = NULL, 108 | numerical.scale = NULL) { 109 | checkKarnaughMapArgument(upsetjs) 110 | stopIfNotType("padding", padding) 111 | stopIfNotType("bar.padding", bar.padding) 112 | stopifnot( 113 | is.null(numerical.scale) || 114 | (numerical.scale == "linear" || numerical.scale == "log") 115 | ) 116 | 117 | props <- list( 118 | padding = padding, 119 | numericalScale = numerical.scale, 120 | barPadding = bar.padding 121 | ) 122 | setProperties(upsetjs, props, clean = TRUE) 123 | } 124 | 125 | #' 126 | #' specify chart labels 127 | #' @param upsetjs an object of class \code{upsetjs} or \code{upsetjs_proxy} 128 | #' @param title the chart title 129 | #' @param description the chart description 130 | #' @param combination.name the label for the combination chart 131 | #' @param combination.name.axis.offset the offset of the combination label from the axis in pixel 132 | #' @param set.name the label for the set chart 133 | #' @param set.name.axis.offset the offset of the set label from the axis in pixel 134 | #' @param bar.label.offset the offset of the bar label from the bar in pixel 135 | #' @return the object given as first argument 136 | #' @examples 137 | #' upsetjs() %>% 138 | #' fromList(list(a = c(1, 2, 3), b = c(2, 3))) %>% 139 | #' chartLabels(set.name = "Test") 140 | #' @export 141 | chartLabels <- function(upsetjs, 142 | title = NULL, 143 | description = NULL, 144 | combination.name = NULL, 145 | combination.name.axis.offset = NULL, 146 | set.name = NULL, 147 | set.name.axis.offset = NULL, 148 | bar.label.offset = NULL) { 149 | checkUpSetArgument(upsetjs) 150 | stopIfNotType("title", title, is.character, "string") 151 | stopIfNotType("description", description, is.character, "string") 152 | stopIfNotType( 153 | "combination.name", 154 | combination.name, 155 | is.character, 156 | "string" 157 | ) 158 | stopIfNotType( 159 | "combination.name.axis.offset", 160 | combination.name.axis.offset 161 | ) 162 | stopIfNotType("set.name", set.name, is.character, "string") 163 | stopIfNotType("set.name.axis.offset", set.name.axis.offset) 164 | stopIfNotType("bar.label.offset", bar.label.offset) 165 | 166 | props <- list( 167 | title = title, 168 | description = description, 169 | setName = set.name, 170 | combinationName = combination.name, 171 | combinationNameAxisOffset = combination.name.axis.offset, 172 | barLabelOffset = bar.label.offset, 173 | setNameAxisOffset = set.name.axis.offset 174 | ) 175 | setProperties(upsetjs, props, clean = TRUE) 176 | } 177 | 178 | #' 179 | #' specify chart labels 180 | #' @param upsetjs an object of class \code{upsetjs_venn} or \code{upsetjs_venn_proxy} 181 | #' @param title the chart title 182 | #' @param description the chart description 183 | #' @return the object given as first argument 184 | #' @examples 185 | #' upsetjsVennDiagram() %>% 186 | #' fromList(list(a = c(1, 2, 3), b = c(2, 3))) %>% 187 | #' chartVennLabels(title = "Test") 188 | #' @export 189 | chartVennLabels <- function(upsetjs, 190 | title = NULL, 191 | description = NULL) { 192 | checkVennDiagramArgument(upsetjs) 193 | stopIfNotType("title", title, is.character, "string") 194 | stopIfNotType("description", description, is.character, "string") 195 | 196 | props <- list( 197 | title = title, 198 | description = description 199 | ) 200 | setProperties(upsetjs, props, clean = TRUE) 201 | } 202 | 203 | #' 204 | #' specify chart labels 205 | #' @param upsetjs an object of class \code{upsetjs_kamp} or \code{upsetjs_kmap_proxy} 206 | #' @param title the chart title 207 | #' @param description the chart description 208 | #' @return the object given as first argument 209 | #' @examples 210 | #' upsetjsKarnaughMap() %>% 211 | #' fromList(list(a = c(1, 2, 3), b = c(2, 3))) %>% 212 | #' chartKarnaughMapLabels(title = "Test") 213 | #' @export 214 | chartKarnaughMapLabels <- function(upsetjs, 215 | title = NULL, 216 | description = NULL) { 217 | checkKarnaughMapArgument(upsetjs) 218 | stopIfNotType("title", title, is.character, "string") 219 | stopIfNotType("description", description, is.character, "string") 220 | 221 | props <- list( 222 | title = title, 223 | description = description 224 | ) 225 | setProperties(upsetjs, props, clean = TRUE) 226 | } 227 | 228 | #' 229 | #' specify chart font sizes 230 | #' @param upsetjs an object of class \code{upsetjs} or \code{upsetjs_proxy} 231 | #' @param font.family specify the font family to render 232 | #' @param chart.label font size of the chart label, default: 16px 233 | #' @param set.label font size of the set label, default: 10px 234 | #' @param axis.tick font size of the axis tick, default: 16px 235 | #' @param bar.label font size of the bar label, default: 10px 236 | #' @param legend font size of the legend label, default: 10px 237 | #' @param title font size of the chart title, default: 24px 238 | #' @param description font size of the chart description, default: 16px 239 | #' @param export.label font size of the export label, default: 10px 240 | #' @param value.label font size of the value label, (venn diagram only) default: 12px 241 | #' @return the object given as first argument 242 | #' @examples 243 | #' upsetjs() %>% 244 | #' fromList(list(a = c(1, 2, 3), b = c(2, 3))) %>% 245 | #' chartFontSizes(font.family = "serif") 246 | #' @export 247 | chartFontSizes <- function(upsetjs, 248 | font.family = NULL, 249 | chart.label = NULL, 250 | set.label = NULL, 251 | axis.tick = NULL, 252 | bar.label = NULL, 253 | legend = NULL, 254 | title = NULL, 255 | description = NULL, 256 | export.label = NULL, 257 | value.label = NULL) { 258 | checkUpSetCommonArgument(upsetjs) 259 | stopIfNotType("font.family", font.family, is.character, "string") 260 | stopIfNotType("chart.label", chart.label, is.character, "string") 261 | stopIfNotType("set.label", set.label, is.character, "string") 262 | stopIfNotType("axis.tick", axis.tick, is.character, "string") 263 | stopIfNotType("bar.label", bar.label, is.character, "string") 264 | stopIfNotType("legend", legend, is.character, "string") 265 | stopIfNotType("title", title, is.character, "string") 266 | stopIfNotType("description", description, is.character, "string") 267 | stopIfNotType("export.label", export.label, is.character, "string") 268 | stopIfNotType("value.label", value.label, is.character, "string") 269 | 270 | font.sizes <- list( 271 | chartLabel = chart.label, 272 | axisTick = axis.tick, 273 | setLabel = set.label, 274 | barLabel = bar.label, 275 | legend = legend, 276 | title = title, 277 | description = description, 278 | exportLabel = export.label, 279 | valueLabel = value.label 280 | ) 281 | props <- list( 282 | fontFamily = font.family, 283 | fontSizes = cleanNull(font.sizes) 284 | ) 285 | setProperties(upsetjs, props, clean = TRUE) 286 | } 287 | 288 | 289 | #' 290 | #' specify chart flags 291 | #' @param upsetjs an object of class \code{upsetjs} or \code{upsetjs_proxy} 292 | #' @param id the optional HTML ID 293 | #' @param export.buttons show export SVG and PNG buttons 294 | #' @param class.name extra CSS class name to the root element 295 | #' @return the object given as first argument 296 | #' @examples 297 | #' upsetjs() %>% 298 | #' fromList(list(a = c(1, 2, 3), b = c(2, 3))) %>% 299 | #' chartStyleFlags(id = "test") 300 | #' @export 301 | chartStyleFlags <- function(upsetjs, 302 | id = NULL, 303 | export.buttons = NULL, 304 | class.name = NULL) { 305 | checkUpSetCommonArgument(upsetjs) 306 | stopIfNotType("export.buttons", export.buttons, is.logical, "boolean") 307 | stopIfNotType("class.name", class.name, is.character, "string") 308 | stopIfNotType("id", id, is.character, "string") 309 | 310 | props <- list( 311 | exportButtons = export.buttons, 312 | className = class.name 313 | ) 314 | setProperties(upsetjs, props, clean = TRUE) 315 | } 316 | 317 | 318 | #' 319 | #' specify theming options 320 | #' @param upsetjs an object of class \code{upsetjs} or \code{upsetjs_proxy} 321 | #' @param theme theme to use 'dark' or 'light' 322 | #' @param color main bar color 323 | #' @param has.selection.color main color used when a selection is present 324 | #' @param opacity main bar opacity 325 | #' @param has.selection.opacity main opacity used when a selection is present 326 | #' @param text.color main text color 327 | #' @param hover.hint.color color of the hover hint 328 | #' @param not.member.color color of the dot if not a member 329 | #' @param selection.color selection color 330 | #' @param alternating.color alternating background color 331 | #' @param value.text.color value text color (venn diagram only) 332 | #' @param stroke.color circle stroke color (venn diagram and karnaugh map only) 333 | #' @param filled enforce filled circles (venn diagram only) 334 | #' @return the object given as first argument 335 | #' @examples 336 | #' upsetjs() %>% 337 | #' fromList(list(a = c(1, 2, 3), b = c(2, 3))) %>% 338 | #' chartTheme(theme = "dark") 339 | #' @export 340 | chartTheme <- function(upsetjs, 341 | theme = NULL, 342 | selection.color = NULL, 343 | alternating.color = NULL, 344 | color = NULL, 345 | has.selection.color = NULL, 346 | text.color = NULL, 347 | hover.hint.color = NULL, 348 | not.member.color = NULL, 349 | value.text.color = NULL, 350 | stroke.color = NULL, 351 | has.selection.opacity = NULL, 352 | opacity = NULL, 353 | filled = NULL) { 354 | checkUpSetCommonArgument(upsetjs) 355 | stopifnot(is.null(theme) || 356 | theme == "light" || 357 | theme == "dark" || theme == "vega") 358 | stopIfNotType("selection.color", selection.color, is.character, "string") 359 | stopIfNotType( 360 | "alternating.color", 361 | alternating.color, 362 | is.character, 363 | "string" 364 | ) 365 | stopIfNotType("color", color, is.character, "string") 366 | stopIfNotType( 367 | "has.selection.color", 368 | has.selection.color, 369 | is.character, 370 | "string" 371 | ) 372 | stopIfNotType("text.color", text.color, is.character, "string") 373 | stopIfNotType( 374 | "hover.hint.color", 375 | hover.hint.color, 376 | is.character, 377 | "string" 378 | ) 379 | stopIfNotType( 380 | "not.member.color", 381 | not.member.color, 382 | is.character, 383 | "string" 384 | ) 385 | stopIfNotType( 386 | "value.text.color", 387 | value.text.color, 388 | is.character, 389 | "string" 390 | ) 391 | stopIfNotType("stroke.color", stroke.color, is.character, "string") 392 | stopIfNotType("opacity", opacity) 393 | stopIfNotType("has.selection.opacity", has.selection.opacity) 394 | stopIfNotType("filled", filled, is.logical, "logical") 395 | 396 | props <- list( 397 | theme = theme, 398 | selectionColor = selection.color, 399 | alternatingBackgroundColor = alternating.color, 400 | color = color, 401 | hasSelectionColor = has.selection.color, 402 | textColor = text.color, 403 | hoverHintColor = hover.hint.color, 404 | notMemberColor = not.member.color, 405 | valueTextColor = value.text.color, 406 | strokeColor = stroke.color, 407 | opacity = opacity, 408 | hasSelectionOpacity = has.selection.opacity, 409 | filled = filled 410 | ) 411 | setProperties(upsetjs, props, clean = TRUE) 412 | } 413 | 414 | #' 415 | #' generic set chart props 416 | #' @param upsetjs an object of class \code{upsetjs} or \code{upsetjs_proxy} 417 | #' @param ... all upsetjs properties in R name notation 418 | #' @return the object given as first argument 419 | #' @examples 420 | #' upsetjs() %>% 421 | #' fromList(list(a = c(1, 2, 3), b = c(2, 3))) %>% 422 | #' chartProps(theme = "dark") 423 | #' @export 424 | chartProps <- function(upsetjs, 425 | ...) { 426 | props <- list(...) 427 | names(props) <- gsub("\\.([a-z])", "\\U\\1", names(props), perl = TRUE) 428 | setProperties(upsetjs, props, clean = TRUE) 429 | } 430 | -------------------------------------------------------------------------------- /R/upsetjs-package.R: -------------------------------------------------------------------------------- 1 | # 2 | # @upsetjs/r 3 | # https://github.com/upsetjs/upsetjs_r 4 | # 5 | # Copyright (c) 2021 Samuel Gratzl 6 | # 7 | 8 | #' Upset.js 9 | #' 10 | #' upsetjs a htmlwidget wrapper around UpSet.js (\url{https://upset.js.org/}) 11 | #' 12 | #' @docType package 13 | #' @name upsetjs 14 | NULL 15 | -------------------------------------------------------------------------------- /R/upsetjs.R: -------------------------------------------------------------------------------- 1 | # 2 | # @upsetjs/r 3 | # https://github.com/upsetjs/upsetjs_r 4 | # 5 | # Copyright (c) 2021 Samuel Gratzl 6 | # 7 | 8 | #' upsetjs sizing policy 9 | #' 10 | #' @param defaultWidth defaults to \code{"100\%"} of the available width 11 | #' @param defaultHeight defaults to 400px tall 12 | #' @param padding defaults to 0px 13 | #' @param browser.fill defaults to \code{TRUE} 14 | #' @param ... all other arguments supplied to \code{htmlwidgets::\link[htmlwidgets]{sizingPolicy}} 15 | #' @return An \code{htmlwidgets::sizingPolicy} object 16 | #' @examples 17 | #' upsetjs(sizingPolicy = upsetjsSizingPolicy(padding = 20)) %>% 18 | #' fromList(list(a = c(1, 2, 3), b = c(2, 3))) 19 | #' @importFrom htmlwidgets sizingPolicy 20 | #' 21 | #' @export 22 | upsetjsSizingPolicy <- function(defaultWidth = "100%", 23 | defaultHeight = 400, 24 | padding = 0, 25 | browser.fill = TRUE, 26 | ...) { 27 | # not adding extra arguments as htmlwidgets::sizingPolicy can change their own args) { 28 | htmlwidgets::sizingPolicy( 29 | defaultWidth = defaultWidth, 30 | defaultHeight = defaultHeight, 31 | padding = padding, 32 | browser.fill = browser.fill, 33 | ... 34 | ) 35 | } 36 | 37 | #' upsetjs - factory for UpSet.js HTMLWidget 38 | #' 39 | #' @param width width of the element 40 | #' @param height height of the element 41 | #' @param elementId unique element id 42 | #' @param sizingPolicy htmlwidgets sizing policy object. Defaults to \code{\link{upsetjsSizingPolicy}()} 43 | #' 44 | #' @return An object of class \code{upsetjs} and \code{htmlwidget} 45 | #' @examples 46 | #' upsetjs() %>% fromList(list(a = c(1, 2, 3), b = c(2, 3))) 47 | #' @importFrom htmlwidgets createWidget 48 | #' @export 49 | upsetjs <- function(width = "100%", 50 | height = NULL, 51 | elementId = NULL, 52 | sizingPolicy = upsetjsSizingPolicy()) { 53 | # forward options using x 54 | x <- structure(list( 55 | sets = c() 56 | )) 57 | 58 | dependencies <- c() 59 | 60 | r <- htmlwidgets::createWidget( 61 | "upsetjs", 62 | x, 63 | width = width, 64 | height = height, 65 | package = "upsetjs", 66 | elementId = elementId, 67 | sizingPolicy = sizingPolicy, 68 | dependencies = dependencies 69 | ) 70 | class(r) <- c(class(r), "upsetjs_common", "upsetjs_upset") 71 | r 72 | } 73 | 74 | #' 75 | #' reactive helper to update an upsetjs inplace 76 | #' @param outputId the id of the upsetjs widget 77 | #' @param session current shiny session 78 | #' @return an object of class \code{upsetjs_proxy} 79 | #' @examples 80 | #' \dontrun{ 81 | #' upsetjsProxy("upsetjs1", session) %>% setSelection("a") 82 | #' } 83 | #' @export 84 | upsetjsProxy <- function(outputId, session) { 85 | structure( 86 | list( 87 | session = session, 88 | id = session$ns(outputId), 89 | x = structure(list()) 90 | ), 91 | class = c("upsetjs_proxy", "upsetjs_upset_proxy", "upsetjs_common_proxy") 92 | ) 93 | } 94 | 95 | 96 | #' upsetjs - factory for UpSet.js Venn Diagram HTMLWidget 97 | #' 98 | #' @param width width of the element 99 | #' @param height height of the element 100 | #' @param elementId unique element id 101 | #' @param sizingPolicy htmlwidgets sizing policy object. Defaults to \code{\link{upsetjsSizingPolicy}()} 102 | #' 103 | #' @return An object of class \code{upsetjs_venn} and \code{htmlwidget} 104 | #' @examples 105 | #' upsetjs() %>% fromList(list(a = c(1, 2, 3), b = c(2, 3))) 106 | #' @importFrom htmlwidgets createWidget 107 | #' @export 108 | upsetjsVennDiagram <- function(width = "100%", 109 | height = NULL, 110 | elementId = NULL, 111 | sizingPolicy = upsetjsSizingPolicy()) { 112 | # forward options using x 113 | x <- structure(list( 114 | renderMode = "venn", 115 | sets = c() 116 | )) 117 | 118 | dependencies <- c() 119 | 120 | r <- htmlwidgets::createWidget( 121 | "upsetjs", 122 | x, 123 | width = width, 124 | height = height, 125 | package = "upsetjs", 126 | elementId = elementId, 127 | sizingPolicy = sizingPolicy, 128 | dependencies = dependencies 129 | ) 130 | class(r) <- c(class(r), "upsetjs_common", "upsetjs_venn") 131 | r 132 | } 133 | 134 | #' 135 | #' reactive helper to update an upsetjs venn diagram in place 136 | #' @param outputId the id of the upsetjs widget 137 | #' @param session current shiny session 138 | #' @return an object of class \code{upsetjs_proxy} 139 | #' @examples 140 | #' \dontrun{ 141 | #' upsetjsVennDiagramProxy("upsetjs1", session) %>% setSelection("a") 142 | #' } 143 | #' @export 144 | upsetjsVennDiagramProxy <- function(outputId, session) { 145 | structure( 146 | list( 147 | session = session, 148 | id = session$ns(outputId), 149 | x = structure(list(renderMode = "venn")) 150 | ), 151 | class = c("upsetjs_proxy", "upsetjs_venn_proxy", "upsetjs_common_proxy") 152 | ) 153 | } 154 | 155 | 156 | #' upsetjs - factory for UpSet.js Euler Diagram HTMLWidget 157 | #' 158 | #' @param width width of the element 159 | #' @param height height of the element 160 | #' @param elementId unique element id 161 | #' @param sizingPolicy htmlwidgets sizing policy object. Defaults to \code{\link{upsetjsSizingPolicy}()} 162 | #' 163 | #' @return An object of class \code{upsetjs_venn} and \code{htmlwidget} 164 | #' @examples 165 | #' upsetjs() %>% fromList(list(a = c(1, 2, 3), b = c(2, 3))) 166 | #' @importFrom htmlwidgets createWidget 167 | #' @export 168 | upsetjsEulerDiagram <- function(width = "100%", 169 | height = NULL, 170 | elementId = NULL, 171 | sizingPolicy = upsetjsSizingPolicy()) { 172 | # forward options using x 173 | x <- structure(list( 174 | renderMode = "euler", 175 | sets = c() 176 | )) 177 | 178 | dependencies <- c() 179 | 180 | r <- htmlwidgets::createWidget( 181 | "upsetjs", 182 | x, 183 | width = width, 184 | height = height, 185 | package = "upsetjs", 186 | elementId = elementId, 187 | sizingPolicy = sizingPolicy, 188 | dependencies = dependencies 189 | ) 190 | class(r) <- c(class(r), "upsetjs_common", "upsetjs_venn") 191 | r 192 | } 193 | 194 | #' 195 | #' reactive helper to update an upsetjs euler diagram in place 196 | #' @param outputId the id of the upsetjs widget 197 | #' @param session current shiny session 198 | #' @return an object of class \code{upsetjs_proxy} 199 | #' @examples 200 | #' \dontrun{ 201 | #' upsetjsEulerDiagramProxy("upsetjs1", session) %>% setSelection("a") 202 | #' } 203 | #' @export 204 | upsetjsEulerDiagramProxy <- function(outputId, session) { 205 | structure( 206 | list( 207 | session = session, 208 | id = session$ns(outputId), 209 | x = structure(list(renderMode = "euler")) 210 | ), 211 | class = c("upsetjs_proxy", "upsetjs_venn_proxy", "upsetjs_common_proxy") 212 | ) 213 | } 214 | 215 | 216 | #' upsetjs - factory for UpSet.js Karnaugh Map HTMLWidget 217 | #' 218 | #' @param width width of the element 219 | #' @param height height of the element 220 | #' @param elementId unique element id 221 | #' @param sizingPolicy htmlwidgets sizing policy object. Defaults to \code{\link{upsetjsSizingPolicy}()} 222 | #' 223 | #' @return An object of class \code{upsetjs_venn} and \code{htmlwidget} 224 | #' @examples 225 | #' upsetjsKarnaughMap() %>% fromList(list(a = c(1, 2, 3), b = c(2, 3))) 226 | #' @importFrom htmlwidgets createWidget 227 | #' @export 228 | upsetjsKarnaughMap <- function(width = "100%", 229 | height = NULL, 230 | elementId = NULL, 231 | sizingPolicy = upsetjsSizingPolicy()) { 232 | # forward options using x 233 | x <- structure(list( 234 | renderMode = "kmap", 235 | sets = c() 236 | )) 237 | 238 | dependencies <- c() 239 | 240 | r <- htmlwidgets::createWidget( 241 | "upsetjs", 242 | x, 243 | width = width, 244 | height = height, 245 | package = "upsetjs", 246 | elementId = elementId, 247 | sizingPolicy = sizingPolicy, 248 | dependencies = dependencies 249 | ) 250 | class(r) <- c(class(r), "upsetjs_common", "upsetjs_kmap") 251 | r 252 | } 253 | 254 | #' 255 | #' reactive helper to update an upsetjs karnaugh map diagram in place 256 | #' @param outputId the id of the upsetjs widget 257 | #' @param session current shiny session 258 | #' @return an object of class \code{upsetjs_proxy} 259 | #' @examples 260 | #' \dontrun{ 261 | #' upsetjsKarnaughMapProxy("upsetjs1", session) %>% setSelection("a") 262 | #' } 263 | #' @export 264 | upsetjsKarnaughMapProxy <- function(outputId, session) { 265 | structure( 266 | list( 267 | session = session, 268 | id = session$ns(outputId), 269 | x = structure(list(renderMode = "kmap")) 270 | ), 271 | class = c("upsetjs_proxy", "upsetjs_kmap_proxy", "upsetjs_common_proxy") 272 | ) 273 | } 274 | -------------------------------------------------------------------------------- /R/utils.R: -------------------------------------------------------------------------------- 1 | # 2 | # @upsetjs/r 3 | # https://github.com/upsetjs/upsetjs_r 4 | # 5 | # Copyright (c) 2021 Samuel Gratzl 6 | # 7 | 8 | checkUpSetCommonArgument <- function(upsetjs) { 9 | if (!inherits(upsetjs, "upsetjs_common") && 10 | !inherits(upsetjs, "upsetjs_common_proxy") && 11 | !inherits(upsetjs, "upsetjs_common_dash")) { 12 | stop("first argument needs to be an upsetjs or upsetjs_venn or upsetjs_kmap instance") 13 | } 14 | } 15 | 16 | checkUpSetArgument <- function(upsetjs) { 17 | if (!inherits(upsetjs, "upsetjs_upset") && 18 | !inherits(upsetjs, "upsetjs_upset_proxy") && 19 | !inherits(upsetjs, "upsetjs_upset_dash")) { 20 | stop("first argument needs to be an upsetjs instance") 21 | } 22 | } 23 | 24 | checkVennDiagramArgument <- function(upsetjs) { 25 | if (!inherits(upsetjs, "upsetjs_venn") && 26 | !inherits(upsetjs, "upsetjs_venn_proxy") && 27 | !inherits(upsetjs, "upsetjs_venn_dash")) { 28 | stop("first argument needs to be an upsetjs_venn instance") 29 | } 30 | } 31 | 32 | checkKarnaughMapArgument <- function(upsetjs) { 33 | if (!inherits(upsetjs, "upsetjs_kmap") && 34 | !inherits(upsetjs, "upsetjs_kmap_proxy") && 35 | !inherits(upsetjs, "upsetjs_kmap_dash")) { 36 | stop("first argument needs to be an upsetjs_kmap instance") 37 | } 38 | } 39 | 40 | isVennDiagram <- function(upsetjs) { 41 | checkUpSetCommonArgument(upsetjs) 42 | inherits(upsetjs, "upsetjs_venn") || 43 | inherits(upsetjs, "upsetjs_venn_proxy") || 44 | inherits(upsetjs, "upsetjs_venn_dash") 45 | } 46 | 47 | isKarnaughMap <- function(upsetjs) { 48 | checkUpSetCommonArgument(upsetjs) 49 | inherits(upsetjs, "upsetjs_kmap") || 50 | inherits(upsetjs, "upsetjs_kmap_proxy") || 51 | inherits(upsetjs, "upsetjs_kmap_dash") 52 | } 53 | 54 | stopIfNotType <- function(name, 55 | value, 56 | type_f = is.numeric, 57 | type_s = "number") { 58 | if (!is.null(value) && !(type_f(value) && length(value) == 1)) { 59 | stop(paste0("argument ", name, " is not a ", type_s)) 60 | } 61 | } 62 | 63 | sendMessage <- function(upsetjsProxy, props, ...) { 64 | session <- upsetjsProxy$session 65 | id <- upsetjsProxy$id 66 | 67 | msg <- structure(list( 68 | id = id, 69 | props = props, 70 | ... 71 | ), 72 | class = "upsetjs_msg" 73 | ) 74 | 75 | session$sendCustomMessage("upsetjs-update", msg) 76 | 77 | upsetjsProxy 78 | } 79 | 80 | enableCrosstalk <- function(upsetjs, shared, mode) { 81 | if (inherits(upsetjs, "upsetjs_common") && 82 | requireNamespace("crosstalk", quietly = TRUE) && 83 | crosstalk::is.SharedData(shared)) { 84 | upsetjs$dependencies <- c(upsetjs$dependencies, crosstalk::crosstalkLibs()) 85 | upsetjs$x$crosstalk <- list(group = shared$groupName(), mode = mode) 86 | } 87 | upsetjs 88 | } 89 | 90 | setProperty <- function(upsetjs, prop, value) { 91 | checkUpSetCommonArgument(upsetjs) 92 | 93 | if (inherits(upsetjs, "upsetjs_common")) { 94 | upsetjs$x[[prop]] <- value 95 | } else if (inherits(upsetjs, "upsetjs_common_proxy")) { 96 | props <- list() 97 | props[[prop]] <- value 98 | sendMessage(upsetjs, props) 99 | } else if (inherits(upsetjs, "upsetjs_common_dash")) { 100 | upsetjs$props[[prop]] <- value 101 | } 102 | upsetjs 103 | } 104 | 105 | appendProperty <- function(upsetjs, prop, value) { 106 | checkUpSetCommonArgument(upsetjs) 107 | 108 | if (inherits(upsetjs, "upsetjs_common")) { 109 | if (is.null(upsetjs$x[[prop]])) { 110 | upsetjs$x[[prop]] <- list(value) 111 | } else { 112 | upsetjs$x[[prop]] <- c(upsetjs$x[[prop]], list(value)) 113 | } 114 | } else if (inherits(upsetjs, "upsetjs_common_proxy")) { 115 | props <- list() 116 | props[[prop]] <- value 117 | sendMessage(upsetjs, props, append = TRUE) 118 | } else if (inherits(upsetjs, "upsetjs_common_dash")) { 119 | if (is.null(upsetjs$x[[prop]])) { 120 | upsetjs$props[[prop]] <- list(value) 121 | } else { 122 | upsetjs$props[[prop]] <- c(upsetjs$props[[prop]], list(value)) 123 | } 124 | } 125 | upsetjs 126 | } 127 | 128 | setProperties <- function(upsetjs, props, clean = FALSE) { 129 | checkUpSetCommonArgument(upsetjs) 130 | 131 | if (clean) { 132 | props <- cleanNull(props) 133 | } 134 | if (inherits(upsetjs, "upsetjs_common")) { 135 | for (prop in names(props)) { 136 | upsetjs$x[[prop]] <- props[[prop]] 137 | } 138 | } else if (inherits(upsetjs, "upsetjs_common_proxy")) { 139 | sendMessage(upsetjs, props) 140 | } else if (inherits(upsetjs, "upsetjs_common_dash")) { 141 | for (prop in names(props)) { 142 | upsetjs$props[[prop]] <- props[[prop]] 143 | } 144 | } 145 | upsetjs 146 | } 147 | 148 | cleanNull <- function(l) { 149 | l[!sapply(l, is.null)] 150 | } 151 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # UpSet.js as R HTMLWidget 2 | 3 | [![CRAN][cran-image]][cran-url] [![Github Actions][github-actions-image]][github-actions-url] [![Open in Binder][binder]][binder-r-url] [![Open Docs][docs]][docs-r-url] [![Open example][example]][example-r-url] 4 | 5 | This is a [HTMLWidget](https://www.htmlwidgets.org/) and [Plot.ly Dash](https://dash.plotly.com/r) wrapper around the JavaScript library [UpSet.js](https://github.com/upsetjs/upsetjs) and an alternative implementation of [UpSetR](https://www.rdocumentation.org/packages/UpSetR). 6 | 7 | This package is part of the UpSet.js ecosystem located at the main [Github Monorepo](https://github.com/upsetjs/upsetjs). 8 | 9 | ## Installation 10 | 11 | ```R 12 | # CRAN version 13 | install.packages('upsetjs') 14 | # or 15 | devtools::install_url("https://github.com/upsetjs/upsetjs_r/releases/latest/download/upsetjs.tar.gz") 16 | 17 | library(upsetjs) 18 | ``` 19 | 20 | ## Example 21 | 22 | ```R 23 | listInput <- list(one = c(1, 2, 3, 5, 7, 8, 11, 12, 13), two = c(1, 2, 4, 5, 10), three = c(1, 5, 6, 7, 8, 9, 10, 12, 13)) 24 | upsetjs() %>% fromList(listInput) %>% interactiveChart() 25 | ``` 26 | 27 | ![List Input Example](https://user-images.githubusercontent.com/4129778/79375541-10dda700-7f59-11ea-933a-a3ffbca1bfd2.png) 28 | 29 | see also [UpSetJS.Rmd](https://github.com/upsetjs/upsetjs_r/blob/main/vignettes/upsetjs.Rmd) 30 | 31 | ## Shiny Example 32 | 33 | ```R 34 | library(shiny) 35 | library(upsetjs) 36 | 37 | listInput <- list(one = c(1, 2, 3, 5, 7, 8, 11, 12, 13), 38 | two = c(1, 2, 4, 5, 10), 39 | three = c(1, 5, 6, 7, 8, 9, 10, 12, 13)) 40 | 41 | ui <- fluidPage( 42 | titlePanel("UpSet.js Shiny Example"), 43 | upsetjsOutput("upsetjs1"), 44 | ) 45 | 46 | server <- function(input, output, session) { 47 | # render upsetjs as interactive plot 48 | output$upsetjs1 <- renderUpsetjs({ 49 | upsetjs() %>% fromList(listInput) %>% interactiveChart() 50 | }) 51 | } 52 | 53 | # Run the application 54 | shinyApp(ui = ui, server = server) 55 | 56 | ``` 57 | 58 | ![shiny](https://user-images.githubusercontent.com/4129778/79375695-51d5bb80-7f59-11ea-8437-40fa60ce425c.png) 59 | 60 | see also [Shiny Examples](https://github.com/upsetjs/upsetjs_r/tree/main/shiny) 61 | 62 | ## Dash Example 63 | 64 | ```R 65 | library(dash) 66 | library(dashHtmlComponents) 67 | library(upsetjs) 68 | 69 | app <- Dash$new() 70 | 71 | app$layout( 72 | htmlDiv( 73 | list( 74 | htmlH1("Hello UpSet.js + Dash"), 75 | upsetjsDash(id = "upset") %>% fromList(list(a = c(1, 2, 3), b = c(2, 3))) 76 | %>% interactiveChart(), 77 | htmlDiv(id = "output") 78 | ) 79 | ) 80 | ) 81 | app$callback( 82 | output = list(id = "output", property = "children"), 83 | params = list(input(id = "upset", property = "selection")), 84 | function(selection) { 85 | sprintf("You selected \"%s\"", selection$name) 86 | } 87 | ) 88 | 89 | app$run_server() 90 | ``` 91 | 92 | TODO 93 | 94 | see also [Dash Examples](https://github.com/upsetjs/upsetjs_r/tree/main/dash) 95 | 96 | ## Documentation 97 | 98 | the package documentation is located at [![Open Docs][docs]][docs-r-url]. An introduction vignette is at [![Open Vignette][example]][example-r-url]. 99 | 100 | ## Venn Diagram 101 | 102 | Besides the main UpSet.js plot also Venn Diagrams for up to five sets are supported. It uses the same input formats and has similar functionality in terms of interaction. 103 | 104 | ```R 105 | listInput <- list(one = c(1, 2, 3, 5, 7, 8, 11, 12, 13), two = c(1, 2, 4, 5, 10), three = c(1, 5, 6, 7, 8, 9, 10, 12, 13)) 106 | upsetjsVennDiagram() %>% fromList(listInput) %>% interactiveChart() 107 | ``` 108 | 109 | ![image](https://user-images.githubusercontent.com/4129778/84817608-8a574b80-b015-11ea-91b8-2ff17bb533e4.png) 110 | 111 | see also [Venn.Rmd](https://github.com/upsetjs/upsetjs_r/blob/main/vignettes/venn.Rmd) 112 | 113 | ## Karnaugh Maps Diagram 114 | 115 | Besides the main UpSet.js plot also a variant of a Karnaugh Map is supported. It uses the same input formats and has similar functionality in terms of interaction. 116 | 117 | ```R 118 | listInput <- list(one = c(1, 2, 3, 5, 7, 8, 11, 12, 13), two = c(1, 2, 4, 5, 10), three = c(1, 5, 6, 7, 8, 9, 10, 12, 13)) 119 | upsetjsKarnaughMap() %>% fromList(listInput) %>% interactiveChart() 120 | ``` 121 | 122 | ![image](https://user-images.githubusercontent.com/4129778/86348506-09789080-bc60-11ea-9ed0-be0560269f7f.png) 123 | 124 | see also [KMap.Rmd](https://github.com/upsetjs/upsetjs_r/blob/main/vignettes/kmap.Rmd) 125 | 126 | ## Dev Environment 127 | 128 | requirements: 129 | 130 | - R with packages: devtools, pkgdown 131 | - pandoc 132 | 133 | ```sh 134 | npm i -g yarn 135 | yarn install 136 | yarn sdks vscode 137 | ``` 138 | 139 | ### Building 140 | 141 | ```sh 142 | yarn lint 143 | yarn build 144 | ``` 145 | 146 | ### R Package 147 | 148 | ```sh 149 | yarn style:r 150 | yarn lint:r 151 | yarn check:r 152 | yarn build:r 153 | ``` 154 | 155 | or in R 156 | 157 | ```R 158 | devtools::load_all() 159 | styler::style_pkg() 160 | lintr::lint_pkg() 161 | devtools::check() 162 | devtools::document() 163 | devtools::build() 164 | ``` 165 | 166 | **R Package Website** 167 | 168 | will be automatically updated upon push 169 | 170 | ```sh 171 | yarn docs:r 172 | ``` 173 | 174 | or in R 175 | 176 | ```R 177 | devtools::build_site() 178 | ``` 179 | 180 | ## Release 181 | 182 | use `release-it` 183 | 184 | ```sh 185 | yarn release 186 | Rscript -e "devtools::release()" 187 | ``` 188 | 189 | ## Privacy Policy 190 | 191 | UpSet.js is a client only library. The library or any of its integrations doesn't track you or transfers your data to any server. The uploaded data in the app are stored in your browser only using IndexedDB. The Tableau extension can run in a sandbox environment prohibiting any server requests. However, as soon as you export your session within the app to an external service (e.g., Codepen.io) your data will be transferred. 192 | 193 | ## License / Terms of Service 194 | 195 | ### Commercial license 196 | 197 | If you want to use UpSet.js for a commercial application or in a commercial environment, the commercial license is the appropriate license. Contact [@sgratzl](mailto:sam@sgratzl.com) for details. 198 | 199 | ### Open-source license 200 | 201 | This library is released under the `GNU AGPLv3` version to be used for private and academic purposes. 202 | In case of a commercial use, please get in touch regarding a commercial license. 203 | 204 | [github-actions-image]: https://github.com/upsetjs/upsetjs_r/workflows/ci/badge.svg 205 | [github-actions-url]: https://github.com/upsetjs/upsetjs_r/actions 206 | [codepen]: https://img.shields.io/badge/CodePen-open-blue?logo=codepen 207 | [binder]: https://mybinder.org/badge_logo.svg 208 | [binder-r-url]: https://mybinder.org/v2/gh/upsetjs/upsetjs_r/main?urlpath=rstudio 209 | [docs]: https://img.shields.io/badge/API-open-blue 210 | [docs-r-url]: https://upset.js.org/integrations/r/ 211 | [example]: https://img.shields.io/badge/Example-open-red 212 | [example-r-url]: https://upset.js.org/integrations/r/articles/upsetjs.html 213 | [cran-image]: https://img.shields.io/cran/v/upsetjs 214 | [cran-url]: https://www.rdocumentation.org/packages/upsetjs 215 | -------------------------------------------------------------------------------- /_pkgdown.yml: -------------------------------------------------------------------------------- 1 | destination: docs 2 | -------------------------------------------------------------------------------- /bench.R: -------------------------------------------------------------------------------- 1 | library(tidyverse) 2 | library(UpSetR) 3 | library(upsetjs) 4 | 5 | # loading example files 6 | toyset_1 <- read_delim( 7 | file = gzfile("./tests/testthat/data/toyset_1.tsv.gz"), 8 | delim = "\t", 9 | escape_double = FALSE, 10 | trim_ws = TRUE 11 | ) %>% 12 | data.frame() 13 | 14 | toyset_2 <- read_delim( 15 | file = gzfile("./tests/testthat/data/toyset_2.tsv.gz"), 16 | delim = "\t", 17 | escape_double = FALSE, 18 | trim_ws = TRUE 19 | ) %>% 20 | data.frame() 21 | 22 | # for upsetR aesthetics 23 | count <- toyset_1 %>% 24 | group_by(attribute1) %>% 25 | count() %>% 26 | arrange(attribute1) 27 | 28 | # upsetR version of toyset_1 29 | ## basic 30 | start <- Sys.time() 31 | upset( 32 | data = toyset_1, 33 | sets = c( 34 | "toy1", 35 | "toy2", 36 | "toy3", 37 | "toy4", 38 | "toy5", 39 | "toy6" 40 | ), 41 | order.by = "freq", 42 | set_size.show = TRUE, 43 | set_size.scale_max = 20000, 44 | ) 45 | end <- Sys.time() 46 | cat("Plotted in", format(end - start), "\n") 47 | 48 | ## advanced (would be really nice to have such coloring options) 49 | start <- Sys.time() 50 | upset( 51 | data = toyset_1, 52 | sets = c( 53 | "toy1", 54 | "toy2", 55 | "toy3", 56 | "toy4", 57 | "toy5", 58 | "toy6" 59 | ), 60 | query.legend = "top", 61 | queries = list( 62 | list( 63 | query = elements, 64 | params = list( 65 | "attribute1", 66 | c( 67 | count[1, 1], 68 | count[2, 1], 69 | count[3, 1] 70 | ) 71 | ), 72 | active = TRUE, 73 | color = "#b2df8a", 74 | query.name = "kin" 75 | ), 76 | list( 77 | query = elements, 78 | params = list( 79 | "attribute1", 80 | c( 81 | count[3, 1], 82 | count[2, 1] 83 | ) 84 | ), 85 | active = TRUE, 86 | color = "#1f78b4", 87 | query.name = "ord" 88 | ), 89 | list( 90 | query = elements, 91 | params = list( 92 | "attribute1", 93 | c(count[3, 1]) 94 | ), 95 | active = TRUE, 96 | color = "#a6cee3", 97 | query.name = "spe" 98 | ) 99 | ), 100 | order.by = "freq", 101 | set_size.show = TRUE, 102 | set_size.scale_max = 20000 103 | ) 104 | end <- Sys.time() 105 | cat("Plotted in", format(end - start), "\n") 106 | 107 | ## bigger matrix () 209'301 x 33 (still not that big imho) 108 | start <- Sys.time() 109 | upset( 110 | toyset_2, 111 | order.by = "freq", 112 | set_size.show = TRUE, 113 | set_size.scale_max = 250000 114 | ) 115 | end <- Sys.time() 116 | cat("Plotted in", format(end - start), "\n") 117 | 118 | # upsetjs version of toyset_1 119 | ## works nicely 120 | start <- Sys.time() 121 | upsetjs() %>% 122 | fromDataFrame(toyset_1[,1:6], c_type="distinctIntersection") %>% 123 | interactiveChart() 124 | end <- Sys.time() 125 | cat("Plotted in", format(end - start), "\n") 126 | 127 | start <- Sys.time() 128 | upset( 129 | toyset_2, 130 | order.by = "freq", 131 | set_size.show = TRUE, 132 | set_size.scale_max = 250000, 133 | nsets = 33 134 | ) 135 | end <- Sys.time() 136 | cat("Plotted in", format(end - start), "\n") 137 | 138 | # upsetjs version of toyset_2 139 | ## last for ages, no idea why... never had the patience to wait until the end 140 | start <- Sys.time() 141 | 142 | upsetjs() %>% 143 | fromDataFrame(toyset_2, c_type="distinctIntersection", store.elems=FALSE, limit = 40) %>% 144 | interactiveChart() 145 | 146 | end <- Sys.time() 147 | cat("Plotted in", format(end - start), "\n") 148 | 149 | # Thanks a lot 150 | -------------------------------------------------------------------------------- /binder/environment.yml: -------------------------------------------------------------------------------- 1 | channels: 2 | - conda-forge 3 | dependencies: 4 | - r-base=3.6 5 | - r-tidyverse 6 | - r-shiny 7 | - r-rmarkdown 8 | - r-devtools 9 | -------------------------------------------------------------------------------- /binder/postBuild: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | set -ex 3 | 4 | Rscript -e "devtools::install_url(\"https://github.com/upsetjs/upsetjs_r/releases/latest/download/upsetjs.tar.gz\")" 5 | -------------------------------------------------------------------------------- /binder/runtime.txt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/upsetjs/upsetjs_r/972b8d4da3a36fa198a79e40014fc57d19aec1fa/binder/runtime.txt -------------------------------------------------------------------------------- /cran-comments.md: -------------------------------------------------------------------------------- 1 | Note: 2 | 3 | This package requires Pandoc for rendering the vignettes since it uses some advanced Markdown Features and HTMLWidgets for rendering this custom widget. 4 | Thus it will fail on build systems in which pandoc is not available like `r-patched-solaris-x86` or `r-oldrel-osx-x86_64`. 5 | -------------------------------------------------------------------------------- /dash/basic.R: -------------------------------------------------------------------------------- 1 | library(dash) 2 | library(dashCoreComponents) 3 | library(dashHtmlComponents) 4 | library(upsetjs) 5 | 6 | app <- Dash$new() 7 | 8 | app$layout( 9 | htmlDiv( 10 | list( 11 | htmlH1("Hello UpSet.js + Dash"), 12 | upsetjsDash(id = "upset") %>% fromList(list(a = c(1, 2, 3), b = c(2, 3))) 13 | %>% interactiveChart(), 14 | htmlDiv(id = "output") 15 | ) 16 | ) 17 | ) 18 | app$callback( 19 | output = list(id = "output", property = "children"), 20 | params = list(input(id = "upset", property = "selection")), 21 | function(selection) { 22 | sprintf("You selected \"%s\"", selection$name) 23 | } 24 | ) 25 | 26 | app$run_server() 27 | -------------------------------------------------------------------------------- /data-raw/got.R: -------------------------------------------------------------------------------- 1 | # 2 | # @upsetjs/r 3 | # https://github.com/upsetjs/upsetjs_r 4 | # 5 | # Copyright (c) 2021 Samuel Gratzl 6 | # 7 | 8 | got <- as.data.frame(read.csv("./data-raw/got.csv", row.names = 1)) 9 | usethis::use_data(got, compress = "bzip2", overwrite = TRUE) 10 | -------------------------------------------------------------------------------- /data-raw/got.csv: -------------------------------------------------------------------------------- 1 | Name,Lannister,Stark,female,male,royal,was killed 2 | Alton Lannister,1,0,0,1,0,1 3 | Arya Stark,0,1,1,0,0,0 4 | Benjen Stark,0,1,0,1,0,1 5 | Bran Stark,0,1,0,1,1,0 6 | Brandon Stark,0,1,0,0,0,1 7 | Catelyn Stark,0,1,1,0,0,1 8 | Cersei Lannister,1,0,1,0,1,1 9 | Eddard Stark,0,1,0,1,0,1 10 | Jaime Lannister,1,0,0,1,0,1 11 | Jon Snow,0,1,0,1,1,1 12 | Kevan Lannister,1,0,0,1,0,1 13 | Lancel Lannister,1,0,0,1,0,1 14 | Lyanna Stark,0,1,1,0,0,1 15 | Martyn Lannister,1,0,0,1,0,1 16 | Rickard Stark,0,1,0,1,0,1 17 | Rickon Stark,0,1,0,1,0,1 18 | Robb Stark,0,1,0,1,1,1 19 | Sansa Stark,0,1,1,0,1,0 20 | Tyrion Lannister,1,0,0,1,0,0 21 | Tywin Lannister,1,0,0,1,0,1 22 | Willem Lannister,1,0,0,1,0,1 23 | -------------------------------------------------------------------------------- /data/got.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/upsetjs/upsetjs_r/972b8d4da3a36fa198a79e40014fc57d19aec1fa/data/got.rda -------------------------------------------------------------------------------- /inst/htmlwidgets/upsetjs.yaml: -------------------------------------------------------------------------------- 1 | dependencies: 2 | -------------------------------------------------------------------------------- /js/_polyfills.ts: -------------------------------------------------------------------------------- 1 | /** 2 | * @upsetjs/r 3 | * https://github.com/upsetjs/upsetjs_r 4 | * 5 | * Copyright (c) 2021 Samuel Gratzl 6 | */ 7 | 8 | import 'core-js'; 9 | import 'element-closest-polyfill'; 10 | import 'regenerator-runtime/runtime'; 11 | -------------------------------------------------------------------------------- /js/dash.tsx: -------------------------------------------------------------------------------- 1 | /** 2 | * @upsetjs/r 3 | * https://github.com/upsetjs/upsetjs_r 4 | * 5 | * Copyright (c) 2021 Samuel Gratzl 6 | */ 7 | import React, { useCallback } from 'react'; 8 | 9 | import { KarnaughMap, UpSetJS, VennDiagram, ISetLike } from '@upsetjs/react'; 10 | import { createContext, fixProps, RBindingUpSetProps, adapter, Elem } from './model'; 11 | import useResizeObserver from 'use-resize-observer'; 12 | 13 | declare type DashUpSetJSProps = RBindingUpSetProps & { 14 | width: string | number | undefined; 15 | height: string | number | undefined; 16 | setProps(props: { selection: { name: string | null; elems: readonly Elem[] } }): void; 17 | }; 18 | 19 | function DashUpSetJSImpl(props: RBindingUpSetProps) { 20 | const context = createContext(props.width, props.height, false); 21 | fixProps(context, props); 22 | if (context.renderMode === 'venn') { 23 | delete context.props.layout; 24 | return ; 25 | } else if (context.renderMode === 'kmap') { 26 | return ; 27 | } else if (context.renderMode === 'euler') { 28 | context.props.layout = adapter; 29 | return ; 30 | } 31 | return ; 32 | } 33 | 34 | export function DashUpSetJS(props: React.PropsWithChildren) { 35 | const { id, width = '100%', height = 300, children, setProps, ...rest } = props; 36 | const { ref, width: computedWidth = 300, height: computedHeight = 300 } = useResizeObserver(); 37 | 38 | const handler = useCallback( 39 | (set: ISetLike | null) => { 40 | setProps({ selection: { name: set ? set.name : null, elems: set ? set.elems || [] : [] } }); 41 | }, 42 | [setProps] 43 | ); 44 | if (props.interactive === true || props.interactive === 'hover') { 45 | rest.onHover = handler; 46 | } else if (props.interactive === 'click') { 47 | rest.onClick = handler; 48 | } else if (props.interactive === 'contextMenu') { 49 | rest.onContextMenu = handler; 50 | } 51 | return ( 52 |
53 | 54 | {children} 55 |
56 | ); 57 | } 58 | -------------------------------------------------------------------------------- /js/htmlwidget.ts: -------------------------------------------------------------------------------- 1 | /** 2 | * @upsetjs/r 3 | * https://github.com/upsetjs/upsetjs_r 4 | * 5 | * Copyright (c) 2021 Samuel Gratzl 6 | */ 7 | 8 | /// 9 | 10 | import './_polyfills'; 11 | import { ISetCombinations, ISetLike, render, renderKarnaughMap, renderVennDiagram } from '@upsetjs/bundle'; 12 | import { adapter, createContext, Elem, fixProps, RBindingUpSetProps } from './model'; 13 | import { resolveSetByElems } from './utils'; 14 | 15 | declare type CrosstalkOptions = { 16 | group: string; 17 | mode: 'click' | 'hover' | 'contextMenu'; 18 | }; 19 | 20 | declare type ShinyUpSetProps = RBindingUpSetProps & { 21 | crosstalk?: CrosstalkOptions; 22 | events_nonce?: boolean; 23 | }; 24 | 25 | declare type CrosstalkHandler = { 26 | mode: 'click' | 'hover' | 'contextMenu'; 27 | update(options: CrosstalkOptions): void; 28 | trigger(elems?: ReadonlyArray): void; 29 | }; 30 | 31 | function isShinyMode(): boolean { 32 | return HTMLWidgets && HTMLWidgets.shinyMode; 33 | } 34 | 35 | function toShinyEventData( 36 | set: (ISetLike & { setNames?: string[] | undefined }) | null, 37 | selected?: ISetLike | readonly string[] | null, 38 | events_nonce = false 39 | ): any { 40 | const nonce = events_nonce ? Date.now() : null; 41 | if (!set) { 42 | return { 43 | name: null, 44 | setNames: [], 45 | cardinality: null, 46 | isSelected: selected == null, 47 | type: null, 48 | elems: [], 49 | nonce, 50 | }; 51 | } 52 | 53 | const cleanSelected = 54 | Array.isArray(selected) || typeof selected === 'function' ? null : (selected as ISetLike | null); 55 | 56 | return { 57 | name: set.name, 58 | setNames: Array.isArray(set.setNames) ? set.setNames : set.setNames == null ? [] : [set.setNames], 59 | cardinality: set.cardinality, 60 | isSelected: 61 | cleanSelected && 62 | cleanSelected.name === set.name && 63 | cleanSelected.type === set.type && 64 | cleanSelected.cardinality === set.cardinality, 65 | type: set.type, 66 | elems: set.elems || [], 67 | nonce, 68 | }; 69 | } 70 | 71 | HTMLWidgets.widget({ 72 | name: 'upsetjs', 73 | type: 'output', 74 | 75 | factory(el, width, height) { 76 | const context = createContext(width, height, isShinyMode(), { 77 | exportButtons: isShinyMode(), 78 | }); 79 | let crosstalkHandler: CrosstalkHandler | null = null; 80 | 81 | function update(delta?: any, append = false) { 82 | if (delta) { 83 | fixProps(context, delta, append); 84 | } 85 | if (context.renderMode === 'venn') { 86 | delete context.props.layout; 87 | renderVennDiagram(el, context.props); 88 | } else if (context.renderMode === 'kmap') { 89 | renderKarnaughMap(el, context.props); 90 | } else if (context.renderMode === 'euler') { 91 | context.props.layout = adapter; 92 | renderVennDiagram(el, context.props); 93 | } else { 94 | render(el, context.props); 95 | } 96 | } 97 | 98 | let bakSelection: ISetLike | null | undefined | ReadonlyArray | ((s: ISetLike) => number) = 99 | null; 100 | 101 | function createHandler(mode: 'hover' | 'click' | 'contextMenu') { 102 | return (set: (ISetLike & { setNames?: string[] }) | null) => { 103 | if (isShinyMode()) { 104 | Shiny.onInputChange( 105 | `${el.id}_${mode}`, 106 | toShinyEventData(set, context.props.selection as ISetLike, context.useNonce) 107 | ); 108 | } 109 | const crosstalk = crosstalkHandler && crosstalkHandler.mode === mode; 110 | if (crosstalk && crosstalkHandler) { 111 | crosstalkHandler.trigger(set?.elems as string[]); 112 | } 113 | if (context.interactive !== mode) { 114 | return; 115 | } 116 | if (mode === 'hover') { 117 | if (set) { 118 | // hover on 119 | bakSelection = context.props.selection; 120 | context.props.selection = set; 121 | } else { 122 | // hover off 123 | context.props.selection = bakSelection; 124 | bakSelection = null; 125 | } 126 | } else { 127 | context.props.selection = set; 128 | } 129 | update(); 130 | }; 131 | } 132 | 133 | context.props.onHover = createHandler('hover'); 134 | context.props.onClick = createHandler('click'); 135 | context.props.onContextMenu = createHandler('contextMenu'); 136 | 137 | function enableCrosstalk(config: CrosstalkOptions): CrosstalkHandler { 138 | const sel = new crosstalk.SelectionHandle(); 139 | sel.setGroup(config.group); 140 | sel.on('change', (event) => { 141 | if (event.sender === sel) { 142 | return; 143 | } 144 | context.props.selection = !event.value 145 | ? null 146 | : resolveSetByElems(event.value, context.props.sets, context.props.combinations as ISetCombinations) || 147 | event.value; 148 | update(); 149 | }); 150 | 151 | // show current state 152 | context.props.selection = !sel.value 153 | ? null 154 | : resolveSetByElems(sel.value, context.props.sets, context.props.combinations as ISetCombinations) || 155 | sel.value; 156 | update(); 157 | 158 | return { 159 | mode: config.mode, 160 | update(options) { 161 | sel.setGroup(options.group); 162 | this.mode = options.mode; 163 | }, 164 | trigger(elems?) { 165 | if (!elems) { 166 | sel.clear(); 167 | } else { 168 | sel.set(elems); 169 | } 170 | }, 171 | }; 172 | } 173 | 174 | (el as any).__update = update; 175 | 176 | return { 177 | renderValue(x: ShinyUpSetProps) { 178 | update(x); 179 | if (x.crosstalk && (window as any).crosstalk && isShinyMode()) { 180 | if (!crosstalkHandler) { 181 | crosstalkHandler = enableCrosstalk(x.crosstalk); 182 | } else { 183 | crosstalkHandler.update(x.crosstalk); 184 | } 185 | } 186 | }, 187 | resize(width: number, height: number) { 188 | update({ 189 | width: width, 190 | height: height, 191 | }); 192 | }, 193 | }; 194 | }, 195 | }); 196 | 197 | if (isShinyMode()) { 198 | Shiny.addCustomMessageHandler('upsetjs-update', (msg) => { 199 | const el = document.getElementById(msg.id); 200 | const update: (props: any, append: boolean) => void = (el as any)?.__update; 201 | if (typeof update === 'function') { 202 | update(msg.props, msg.append); 203 | } 204 | }); 205 | } 206 | -------------------------------------------------------------------------------- /js/model.ts: -------------------------------------------------------------------------------- 1 | /** 2 | * @upsetjs/r 3 | * https://github.com/upsetjs/upsetjs_r 4 | * 5 | * Copyright (c) 2021 Samuel Gratzl 6 | */ 7 | import { 8 | boxplotAddon, 9 | categoricalAddon, 10 | createVennJSAdapter, 11 | isElemQuery, 12 | ISetCombinations, 13 | ISets, 14 | isSetQuery, 15 | KarnaughMapProps, 16 | UpSetProps, 17 | VennDiagramProps, 18 | } from '@upsetjs/bundle'; 19 | import { layout } from '@upsetjs/venn.js'; 20 | import { fixCombinations, fixSets, fromExpression, resolveSet } from './utils'; 21 | 22 | export declare type Elem = string; 23 | 24 | export declare type RBindingUpSetProps = UpSetProps & 25 | VennDiagramProps & { 26 | renderMode: 'upset' | 'venn' | 'euler' | 'kmap'; 27 | expressionData?: boolean; 28 | interactive?: boolean | 'hover' | 'click' | 'contextMenu'; 29 | 30 | elems: ReadonlyArray; 31 | attrs: ReadonlyArray; 32 | }; 33 | 34 | declare type UpSetNumericAttrSpec = { 35 | type: 'number'; 36 | name: string; 37 | domain: [number, number]; 38 | values: ReadonlyArray; 39 | elems?: ReadonlyArray; 40 | }; 41 | declare type UpSetCategoricalAttrSpec = { 42 | type: 'categorical'; 43 | name: string; 44 | categories: ReadonlyArray; 45 | values: ReadonlyArray; 46 | elems?: ReadonlyArray; 47 | }; 48 | 49 | export declare type UpSetAttrSpec = UpSetNumericAttrSpec | UpSetCategoricalAttrSpec; 50 | 51 | export const adapter = createVennJSAdapter(layout); 52 | 53 | export function syncAddons( 54 | props: UpSetProps & VennDiagramProps & KarnaughMapProps, 55 | elemToIndex: Map, 56 | attrs: UpSetAttrSpec[] 57 | ) { 58 | if (attrs.length === 0) { 59 | delete props.setAddons; 60 | delete props.combinationAddons; 61 | return; 62 | } 63 | const toAddon = (attr: UpSetAttrSpec, vertical = false) => { 64 | const lookup = attr.elems ? new Map(attr.elems.map((e, i) => [e, i])) : elemToIndex; 65 | if (attr.type === 'number') { 66 | return boxplotAddon( 67 | (v) => (lookup.has(v) ? attr.values[lookup.get(v)!] : Number.NaN), 68 | { min: attr.domain[0], max: attr.domain[1] }, 69 | { 70 | name: attr.name, 71 | quantiles: 'hinges', 72 | orient: vertical ? 'vertical' : 'horizontal', 73 | } 74 | ); 75 | } 76 | return categoricalAddon( 77 | (v) => (lookup.has(v) ? attr.values[lookup.get(v)!] : ''), 78 | { 79 | categories: attr.categories, 80 | }, 81 | { 82 | name: attr.name, 83 | orient: vertical ? 'vertical' : 'horizontal', 84 | } 85 | ); 86 | }; 87 | props.setAddons = attrs.map((attr) => toAddon(attr, false)); 88 | props.combinationAddons = attrs.map((attr) => toAddon(attr, true)); 89 | } 90 | 91 | export interface RenderContext { 92 | props: UpSetProps & VennDiagramProps & KarnaughMapProps; 93 | elemToIndex: Map; 94 | attrs: UpSetAttrSpec[]; 95 | interactive: false | 'hover' | 'click' | 'contextMenu'; 96 | renderMode: 'upset' | 'venn' | 'euler' | 'kmap'; 97 | useNonce: boolean; 98 | } 99 | 100 | export function createContext( 101 | width: number, 102 | height: number, 103 | interactive: boolean, 104 | extra: Partial = {} 105 | ): RenderContext { 106 | return { 107 | interactive: interactive ? 'hover' : false, 108 | renderMode: 'upset', 109 | useNonce: false, 110 | elemToIndex: new Map(), 111 | attrs: [], 112 | props: { 113 | sets: [], 114 | width, 115 | height, 116 | ...extra, 117 | }, 118 | }; 119 | } 120 | 121 | export function fixProps(context: RenderContext, delta: any, append = false) { 122 | if (append) { 123 | Object.keys(delta).forEach((key) => { 124 | const p = context.props as any; 125 | const old = p[key] || []; 126 | p[key] = old.concat(delta[key]); 127 | }); 128 | } else { 129 | Object.assign(context.props, delta); 130 | } 131 | 132 | if (typeof delta.interactive === 'boolean' || typeof delta.interactive === 'string') { 133 | context.interactive = typeof delta.interactive === 'boolean' ? 'hover' : delta.interactive; 134 | } 135 | if (typeof delta.events_nonce === 'boolean') { 136 | context.useNonce = delta.events_nonce; 137 | } 138 | const expressionData = delta.expressionData; 139 | if (typeof delta.renderMode === 'string') { 140 | context.renderMode = delta.renderMode; 141 | } 142 | delete (context.props as any).renderMode; 143 | delete (context.props as any).interactive; 144 | delete (context.props as any).expressionData; 145 | delete (context.props as any).crosstalk; 146 | if (delta.elems) { 147 | // elems = delta.elems; 148 | context.elemToIndex.clear(); 149 | delta.elems.forEach((elem: Elem, i: number) => context.elemToIndex.set(elem, i)); 150 | } 151 | delete (context.props as any).elems; 152 | if (delta.attrs) { 153 | context.attrs = delta.attrs; 154 | syncAddons(context.props, context.elemToIndex, context.attrs); 155 | } 156 | delete (context.props as any).attrs; 157 | 158 | if (delta.sets != null) { 159 | context.props.sets = fixSets(context.props.sets); 160 | } 161 | if (delta.combinations != null) { 162 | if (expressionData) { 163 | const r = fromExpression(delta.combinations); 164 | context.props.combinations = r.combinations as ISetCombinations; 165 | context.props.sets = r.sets as ISets; 166 | } else { 167 | const c = fixCombinations(delta.combinations, context.props.sets); 168 | if (c == null) { 169 | delete context.props.combinations; 170 | } else { 171 | context.props.combinations = c; 172 | } 173 | } 174 | } 175 | if (delta.selection == null || delta.selection === '') { 176 | context.props.selection = null; 177 | } else if (typeof delta.selection === 'string' || Array.isArray(delta.selection)) { 178 | context.props.selection = resolveSet( 179 | delta.selection, 180 | null, 181 | context.props.sets, 182 | context.props.combinations as ISetCombinations 183 | ); 184 | } else if (typeof delta.selection?.name === 'string') { 185 | context.props.selection = resolveSet( 186 | delta.selection.name, 187 | delta.selection.type, 188 | context.props.sets, 189 | context.props.combinations as ISetCombinations 190 | ); 191 | } 192 | 193 | if (delta.queries) { 194 | context.props.queries = delta.queries.map((query: any) => { 195 | const base = Object.assign({}, query); 196 | if (isSetQuery(query) && (typeof query.set === 'string' || Array.isArray(query.set))) { 197 | base.set = resolveSet( 198 | query.set, 199 | (query as any).type, 200 | context.props.sets, 201 | context.props.combinations as ISetCombinations 202 | )!; 203 | } else if (isElemQuery(query) && typeof query.elems !== 'undefined' && !Array.isArray(query.elems)) { 204 | base.elems = [query.elems]; 205 | } 206 | return base; 207 | }); 208 | } 209 | } 210 | -------------------------------------------------------------------------------- /js/utils.ts: -------------------------------------------------------------------------------- 1 | /** 2 | * @upsetjs/r 3 | * https://github.com/upsetjs/upsetjs_r 4 | * 5 | * Copyright (c) 2021 Samuel Gratzl 6 | */ 7 | 8 | import { 9 | asCombinations, 10 | asSets, 11 | generateCombinations, 12 | GenerateSetCombinationsOptions, 13 | ISetCombination, 14 | ISetCombinations, 15 | ISets, 16 | ISetLike, 17 | extractFromExpression, 18 | SetCombinationType, 19 | } from '@upsetjs/bundle'; 20 | 21 | export function fixSets(sets: ISets) { 22 | if (!sets) { 23 | return []; 24 | } 25 | return asSets( 26 | sets.map((set) => { 27 | if (!Array.isArray(set.elems)) { 28 | (set as any).elems = set.elems == null ? [] : [set.elems]; 29 | } 30 | return set; 31 | }) 32 | ); 33 | } 34 | 35 | export function fromExpression( 36 | combinations: { name: string; cardinality: number; setNames: string[]; type: SetCombinationType }[] 37 | ) { 38 | const type = combinations[0].type; 39 | return extractFromExpression( 40 | combinations.map((set) => ({ 41 | name: set.name, 42 | setNames: Array.isArray(set.setNames) ? set.setNames : set.setNames == null ? [] : [set.setNames], 43 | cardinality: set.cardinality, 44 | })), 45 | (c) => c.setNames, 46 | { 47 | type, 48 | } 49 | ); 50 | } 51 | 52 | export function fixCombinations( 53 | combinations: 54 | | GenerateSetCombinationsOptions 55 | | readonly (ISetCombination & { setNames?: string[] })[] 56 | | undefined, 57 | sets: ISets 58 | ) { 59 | if (!combinations || (Array.isArray(combinations) && combinations.length === 0)) { 60 | return null; 61 | } 62 | if (!Array.isArray(combinations)) { 63 | return generateCombinations(sets, combinations as GenerateSetCombinationsOptions); 64 | } 65 | const lookup = new Map(sets.map((s) => [s.name, s])); 66 | return asCombinations( 67 | combinations.map((set) => { 68 | if (!Array.isArray(set.elems)) { 69 | (set as any).elems = set.elems == null ? [] : [set.elems]; 70 | } 71 | if (!Array.isArray(set.setNames)) { 72 | set.setNames = set.setNames == null ? [] : [set.setNames]; 73 | } 74 | return set; 75 | }), 76 | 'composite', 77 | (s: any) => s.setNames.map((si: string) => lookup.get(si)).filter(Boolean) 78 | ); 79 | } 80 | 81 | function toUnifiedCombinationName(c: ISetCombination) { 82 | return Array.from(c.sets) 83 | .map((s) => s.name) 84 | .sort() 85 | .join('&'); 86 | } 87 | 88 | export function resolveSet( 89 | set: string | string[], 90 | type: null | undefined | ISetLike['type'], 91 | sets: ISets, 92 | combinations: ISetCombinations 93 | ) { 94 | const s = sets.find((s) => s.name === set && type != null && type === s.type); 95 | if (s) { 96 | return s; 97 | } 98 | const combinedNames = Array.isArray(set) ? set.slice().sort().join('&') : null; 99 | return combinations.find((c) => { 100 | return ( 101 | c.name === set || 102 | (combinedNames && combinedNames === toUnifiedCombinationName(c) && type != null && type === c.type) 103 | ); 104 | }); 105 | } 106 | 107 | export function resolveSetByElems(elems: ReadonlyArray, sets: ISets, combinations: ISetCombinations) { 108 | const set = new Set(elems); 109 | const sameElems = (s: ISetLike) => { 110 | if (!s.elems || s.elems.length !== set.size) { 111 | return false; 112 | } 113 | return s.elems.every((v) => set.has(v)); 114 | }; 115 | 116 | const r = sets.find(sameElems); 117 | if (r) { 118 | return r; 119 | } 120 | return combinations.find(sameElems); 121 | } 122 | -------------------------------------------------------------------------------- /package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "@upsetjs/r", 3 | "description": "UpSet.js is a re-implementation of UpSetR to create interactive set visualizations for more than three sets", 4 | "version": "1.11.1", 5 | "private": true, 6 | "license": "SEE LICENSE in LICENSE", 7 | "author": { 8 | "name": "Samuel Gratzl", 9 | "email": "sam@sgratzl.com", 10 | "url": "https://wwww.sgratzl.com" 11 | }, 12 | "homepage": "https://github.com/upsetjs/upsetjs_r", 13 | "bugs": { 14 | "url": "https://github.com/upsetjs/upsetjs_r/issues" 15 | }, 16 | "repository": { 17 | "type": "git", 18 | "url": "https://github.com/sgratzl/upsetjs_r.git" 19 | }, 20 | "scripts": { 21 | "lint": "yarn run eslint && yarn run prettier", 22 | "fix": "yarn run eslint:fix && yarn run prettier:write", 23 | "prettier:impl": "prettier \"*.md\" \"*.json\" .eslintrc.js \"*.yml\" \"webpack*\" .prettierrc.js \"{js,types,scripts,.github}/**\" \"binder/*.yml\" ", 24 | "prettier:write": "yarn run prettier:impl --write", 25 | "prettier": "yarn run prettier:impl --check", 26 | "eslint": "eslint js --ext .ts,.tsx", 27 | "eslint:fix": "yarn run eslint --fix", 28 | "clean": "rimraf \"inst/htmlwidgets/upsetjs.js*\"", 29 | "build:dev": "webpack-cli --mode development --devtool source-map", 30 | "build": "yarn run clean && webpack-cli --mode production", 31 | "test:r": "Rscript -e 'devtools::test()'", 32 | "check:r": "rimraf node_modules && Rscript -e 'devtools::check(error_on = \"error\")'", 33 | "style:r": "Rscript -e 'styler::style_pkg()'", 34 | "lint:r": "Rscript -e 'devtools::load_all();lintr::lint_package()'", 35 | "clean:r": "rimraf \"*.tar.gz\" check man doc docs NAMESPACE \"vignettes/*.R\" \"vignettes/*.html\" upsetjs.Rcheck Meta node_modules", 36 | "build:r": "yarn run clean:r && Rscript -e 'devtools::document()' -e 'devtools::build(path=\".\")' -e 'file.copy(list.files(pattern=\"upsetjs_.*.tar.gz\"), \"upsetjs.tar.gz\")'", 37 | "docs:r": "Rscript -e 'devtools::build_site()'", 38 | "release": "release-it --disable-metrics" 39 | }, 40 | "browserslist": [ 41 | "ie 11" 42 | ], 43 | "devDependencies": { 44 | "@babel/core": "^7.17.10", 45 | "@babel/preset-env": "^7.17.10", 46 | "@typescript-eslint/eslint-plugin": "^5.23.0", 47 | "@typescript-eslint/parser": "^5.23.0", 48 | "@yarnpkg/sdks": "^3.0.0-rc.5", 49 | "babel-loader": "^8.2.5", 50 | "eslint": "^8.15.0", 51 | "eslint-config-prettier": "^8.5.0", 52 | "eslint-config-react-app": "^7.0.1", 53 | "eslint-plugin-flowtype": "^8.0.3", 54 | "eslint-plugin-import": "^2.26.0", 55 | "eslint-plugin-jsx-a11y": "^6.5.1", 56 | "eslint-plugin-prettier": "^4.0.0", 57 | "eslint-plugin-react": "^7.29.4", 58 | "eslint-plugin-react-hooks": "^4.5.0", 59 | "html-webpack-plugin": "^5.5.0", 60 | "pnp-webpack-plugin": "^1.7.0", 61 | "prettier": "^2.6.2", 62 | "react": "^18.1", 63 | "release-it": "^14.14.3", 64 | "rimraf": "^3.0.2", 65 | "ts-loader": "^9.3.0", 66 | "tslib": "^2.4.0", 67 | "typescript": "^4.6.4", 68 | "webpack": "^5.72.1", 69 | "webpack-cli": "^4.9.2" 70 | }, 71 | "dependencies": { 72 | "@types/react": "^18.0", 73 | "@upsetjs/bundle": "~1.11.0", 74 | "@upsetjs/react": "~1.11.0", 75 | "@upsetjs/venn.js": "^1.4.2", 76 | "core-js": "^2", 77 | "element-closest-polyfill": "^1.0.5", 78 | "regenerator-runtime": "^0.13.9", 79 | "use-resize-observer": "^8.0.0" 80 | }, 81 | "peerDependencies": { 82 | "react": "^18.1" 83 | }, 84 | "packageManager": "yarn@3.2.0" 85 | } 86 | -------------------------------------------------------------------------------- /scripts/bump.js: -------------------------------------------------------------------------------- 1 | const { Plugin } = require('release-it'); 2 | const fs = require('fs'); 3 | const path = require('path'); 4 | 5 | function bumpImpl(version) { 6 | const desc = path.resolve('./DESCRIPTION'); 7 | const content = fs.readFileSync(desc).toString(); 8 | const s = new Date().toISOString(); 9 | const now = s.slice(0, s.indexOf('T')); 10 | const newContent = content.replace(/^Version:.*$/gm, `Version: ${version}`).replace(/^Date:.*$/gm, `Date: ${now}`); 11 | fs.writeFileSync(desc, newContent); 12 | } 13 | 14 | class MyVersionPlugin extends Plugin { 15 | bump(version) { 16 | bumpImpl(version); 17 | } 18 | } 19 | 20 | module.exports = MyVersionPlugin; 21 | -------------------------------------------------------------------------------- /shiny/basic.R: -------------------------------------------------------------------------------- 1 | # 2 | # @upsetjs/r 3 | # https://github.com/upsetjs/upsetjs_r 4 | # 5 | # Copyright (c) 2021 Samuel Gratzl 6 | # 7 | 8 | # 9 | # This is a Shiny web application. You can run the application by clicking 10 | # the 'Run App' button above. 11 | # 12 | # Find out more about building applications with Shiny here: 13 | # 14 | # https://shiny.rstudio.com/ 15 | # 16 | 17 | library(shiny) 18 | library(upsetjs) 19 | 20 | listInput <- list(one = c(1, 2, 3, 5, 7, 8, 11, 12, 13), 21 | two = c(1, 2, 4, 5, 10), 22 | three = c(1, 5, 6, 7, 8, 9, 10, 12, 13)) 23 | 24 | ui <- fluidPage( 25 | titlePanel("UpSet.js Shiny Example"), 26 | upsetjsOutput("upsetjs1"), 27 | ) 28 | 29 | server <- function(input, output, session) { 30 | # render upsetjs as interactive plot 31 | output$upsetjs1 <- renderUpsetjs({ 32 | upsetjs() %>% fromList(listInput) %>% interactiveChart() 33 | }) 34 | } 35 | 36 | # Run the application 37 | shinyApp(ui = ui, server = server) 38 | 39 | -------------------------------------------------------------------------------- /shiny/crosstalk.R: -------------------------------------------------------------------------------- 1 | # 2 | # @upsetjs/r 3 | # https://github.com/upsetjs/upsetjs_r 4 | # 5 | # Copyright (c) 2021 Samuel Gratzl 6 | # 7 | 8 | # 9 | # This is a Shiny web application. You can run the application by clicking 10 | # the 'Run App' button above. 11 | # 12 | # Find out more about building applications with Shiny here: 13 | # 14 | # https://shiny.rstudio.com/ 15 | # 16 | 17 | library(shiny) 18 | library(crosstalk) 19 | library(plotly) 20 | library(upsetjs) 21 | 22 | movies <- read.csv( system.file("extdata", "movies.csv", package = "UpSetR"), header=TRUE, sep=";" ) 23 | rownames(movies) <- movies$Name 24 | 25 | ds <- SharedData$new(movies) 26 | 27 | ui <- fluidPage( 28 | titlePanel("UpSet.js Shiny Example"), 29 | upsetjsOutput("upsetjs1"), 30 | plotlyOutput("plotly1") 31 | ) 32 | 33 | server <- function(input, output, session) { 34 | # render upsetjs as interactive plot 35 | output$upsetjs1 <- renderUpsetjs({ 36 | upsetjs() %>% fromDataFrame(movies[,3:16], limit=5, shared=ds) 37 | }) 38 | output$plotly1 <- renderPlotly({ 39 | plot_ly(ds, x=~AvgRating, y=~Watches, type="scatter", mode="markers") 40 | }) 41 | } 42 | 43 | # Run the application 44 | shinyApp(ui = ui, server = server) 45 | 46 | -------------------------------------------------------------------------------- /shiny/events.R: -------------------------------------------------------------------------------- 1 | # 2 | # @upsetjs/r 3 | # https://github.com/upsetjs/upsetjs_r 4 | # 5 | # Copyright (c) 2021 Samuel Gratzl 6 | # 7 | 8 | # 9 | # This is a Shiny web application. You can run the application by clicking 10 | # the 'Run App' button above. 11 | # 12 | # Find out more about building applications with Shiny here: 13 | # 14 | # https://shiny.rstudio.com/ 15 | # 16 | 17 | library(shiny) 18 | library(upsetjs) 19 | 20 | listInput <- list(one = c(1, 2, 3, 5, 7, 8, 11, 12, 13), 21 | two = c(1, 2, 4, 5, 10), 22 | three = c(1, 5, 6, 7, 8, 9, 10, 12, 13)) 23 | 24 | ui <- fluidPage( 25 | titlePanel("UpSet.js Shiny Example"), 26 | upsetjsOutput("upsetjs1"), 27 | fluidRow( 28 | column(2, "Hovered Set"), 29 | column(2, textOutput("hovered")), 30 | column(8, textOutput("hoveredElements")) 31 | ), 32 | fluidRow( 33 | column(2, "Clicked Set"), 34 | column(2, textOutput("clicked")), 35 | column(8, textOutput("clickedElements")) 36 | ) 37 | ) 38 | 39 | server <- function(input, output, session) { 40 | 41 | output$hovered <- renderText({ 42 | # hover event: _hover -> list(name="NAME" or NULL, elems=c(...)) 43 | input$upsetjs1_hover$name 44 | }) 45 | output$hoveredElements <- renderText({ 46 | as.numeric(input$upsetjs1_hover$elems) 47 | }) 48 | output$clicked <- renderText({ 49 | # click event: _hover -> list(name="NAME" or NULL, elems=c(...)) 50 | input$upsetjs1_click$name 51 | }) 52 | output$clickedElements <- renderText({ 53 | as.numeric(input$upsetjs1_click$elems) 54 | }) 55 | 56 | # render upsetjs as interactive plot 57 | output$upsetjs1 <- renderUpsetjs({ 58 | upsetjs() %>% fromList(listInput) %>% interactiveChart() 59 | }) 60 | } 61 | 62 | # Run the application 63 | shinyApp(ui = ui, server = server) 64 | 65 | -------------------------------------------------------------------------------- /shiny/selection.R: -------------------------------------------------------------------------------- 1 | # 2 | # @upsetjs/r 3 | # https://github.com/upsetjs/upsetjs_r 4 | # 5 | # Copyright (c) 2021 Samuel Gratzl 6 | # 7 | 8 | # 9 | # This is a Shiny web application. You can run the application by clicking 10 | # the 'Run App' button above. 11 | # 12 | # Find out more about building applications with Shiny here: 13 | # 14 | # https://shiny.rstudio.com/ 15 | # 16 | 17 | library(shiny) 18 | library(upsetjs) 19 | 20 | listInput <- list(one = c(1, 2, 3, 5, 7, 8, 11, 12, 13), 21 | two = c(1, 2, 4, 5, 10), 22 | three = c(1, 5, 6, 7, 8, 9, 10, 12, 13)) 23 | 24 | ui <- fluidPage( 25 | titlePanel("UpSet.js Shiny Example"), 26 | radioButtons("set", label = "Set to highlight", choices = c("one", "two", "three")), 27 | upsetjsOutput("upsetjs1") 28 | ) 29 | 30 | server <- function(input, output, session) { 31 | # render upsetjs as interactive plot 32 | output$upsetjs1 <- renderUpsetjs({ 33 | upsetjs() %>% fromList(listInput) %>% setSelection(input$set) 34 | }) 35 | } 36 | 37 | # Run the application 38 | shinyApp(ui = ui, server = server) 39 | 40 | -------------------------------------------------------------------------------- /shiny/selectionP/app.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | library(upsetjs) 3 | library(purrr) 4 | library(dplyr) 5 | 6 | set_list_2_combinations <- function(set_list) { 7 | set_list <- set_list[ 8 | order(purrr::map_int(set_list, length), decreasing = TRUE) 9 | ] 10 | set_names <- names(set_list) 11 | purrr::map(seq_along(set_names), ~{ 12 | lst <- combn(set_names, .x) %>% as.data.frame() %>% as.list() 13 | names(lst) <- purrr::map_chr(lst, ~paste0(.x, collapse = "&")) 14 | lst 15 | }) %>% unlist(recursive = FALSE) 16 | } 17 | 18 | set_list <- list("A" = c(1,2,3,4,5),"B" = c(1,2,3),"C" = c(2,6,7,8)) 19 | combinations <- c(list("none" = ""), set_list_2_combinations(set_list)) 20 | 21 | # reactive values ---- 22 | # I next tried a compromise still re-rendering the plot in place of proxy 23 | # but with a reactive value that would respond to clicks in place of a direct 24 | # input - this also did not work 25 | ui <- fluidPage( 26 | shiny::sidebarLayout( 27 | shiny::sidebarPanel( 28 | actionButton("reset_selection", "Reset Selection"), 29 | verbatimTextOutput("selection") 30 | ), 31 | shiny::mainPanel( 32 | upsetjs::upsetjsOutput("upset_plot") 33 | ) 34 | ) 35 | ) 36 | 37 | server <- function(input, output, session) { 38 | 39 | output$upset_plot <- upsetjs::renderUpsetjs({ 40 | upsetjs::upsetjs() %>% 41 | upsetjs::fromList(set_list) %>% 42 | upsetjs::interactiveChart('click', events_nonce = TRUE) 43 | }) 44 | 45 | upset_selection <- reactiveValues(selected_sets = '') 46 | 47 | observeEvent(upset_selection$selected_sets, { 48 | upsetjs::upsetjsProxy('upset_plot', session) %>% 49 | upsetjs::setSelection(upset_selection$selected_sets) 50 | }) 51 | 52 | 53 | observeEvent(input$upset_plot_click, { 54 | if(isTRUE(input$upset_plot_click[['isSelected']])) { 55 | upset_selection$selected_sets <- '' 56 | } else { 57 | upset_selection$selected_sets <- input$upset_plot_click 58 | } 59 | }) 60 | 61 | observeEvent(input$reset_selection, { 62 | upset_selection$selected_sets <- '' 63 | }) 64 | 65 | # debug info 66 | output$selection <- renderText({ 67 | jsonlite::toJSON(upset_selection$selected_sets) 68 | }) 69 | } 70 | 71 | shinyApp(ui, server) 72 | -------------------------------------------------------------------------------- /shiny/selectionProxy.R: -------------------------------------------------------------------------------- 1 | # 2 | # @upsetjs/r 3 | # https://github.com/upsetjs/upsetjs_r 4 | # 5 | # Copyright (c) 2021 Samuel Gratzl 6 | # 7 | 8 | # 9 | # This is a Shiny web application. You can run the application by clicking 10 | # the 'Run App' button above. 11 | # 12 | # Find out more about building applications with Shiny here: 13 | # 14 | # https://shiny.rstudio.com/ 15 | # 16 | 17 | library(shiny) 18 | library(upsetjs) 19 | 20 | listInput <- list(one = c(1, 2, 3, 5, 7, 8, 11, 12, 13), 21 | two = c(1, 2, 4, 5, 10), 22 | three = c(1, 5, 6, 7, 8, 9, 10, 12, 13)) 23 | 24 | ui <- fluidPage( 25 | titlePanel("UpSet.js Shiny Example"), 26 | radioButtons("set", label = "Set to highlight", choices = c("one", "two", "three")), 27 | upsetjsOutput("upsetjs1") 28 | ) 29 | 30 | server <- function(input, output, session) { 31 | 32 | observeEvent(input$set, { 33 | # using a proxy for inline updates 34 | upsetjsProxy("upsetjs1", session) %>% setSelection(input$set) 35 | }) 36 | 37 | # render upsetjs as interactive plot 38 | output$upsetjs1 <- renderUpsetjs({ 39 | upsetjs() %>% fromList(listInput) 40 | }) 41 | } 42 | 43 | # Run the application 44 | shinyApp(ui = ui, server = server) 45 | 46 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(upsetjs) 3 | 4 | test_check("upsetjs") 5 | -------------------------------------------------------------------------------- /tests/testthat/data/toyset_1.tsv.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/upsetjs/upsetjs_r/972b8d4da3a36fa198a79e40014fc57d19aec1fa/tests/testthat/data/toyset_1.tsv.gz -------------------------------------------------------------------------------- /tests/testthat/data/toyset_2.tsv.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/upsetjs/upsetjs_r/972b8d4da3a36fa198a79e40014fc57d19aec1fa/tests/testthat/data/toyset_2.tsv.gz -------------------------------------------------------------------------------- /tests/testthat/helpers.R: -------------------------------------------------------------------------------- 1 | # 2 | # @upsetjs/r 3 | # https://github.com/upsetjs/upsetjs_r 4 | # 5 | # Copyright (c) 2021 Samuel Gratzl 6 | # 7 | 8 | upsetjs_mock <- function() { 9 | x <- structure(list( 10 | sets = c() 11 | )) 12 | 13 | r <- list( 14 | x = x, 15 | package = "upsetjs" 16 | ) 17 | class(r) <- c(class(r), "upsetjs_common", "upsetjs_upset") 18 | r 19 | } 20 | 21 | expect_set <- function(s, name, cardinality, check.length = TRUE) { 22 | expect_equal(s$name, name) 23 | expect_equal(s$cardinality, cardinality) 24 | if (check.length) { 25 | expect_equal(length(s$elems), cardinality) 26 | } 27 | } 28 | -------------------------------------------------------------------------------- /tests/testthat/test-data.R: -------------------------------------------------------------------------------- 1 | # 2 | # @upsetjs/r 3 | # https://github.com/upsetjs/upsetjs_r 4 | # 5 | # Copyright (c) 2021 Samuel Gratzl 6 | # 7 | 8 | test_that("fromList", { 9 | listInput <- list(one = c("a", "b", "c", "e", "g", "h", "k", "l", "m"), two = c("a", "b", "d", "e", "j"), three = c("a", "e", "f", "g", "h", "i", "j", "l", "m")) 10 | 11 | u <- upsetjs_mock() %>% fromList(listInput, order.by = "degree") 12 | sets <- u %>% getSets() 13 | expect_equal(length(sets), 3) 14 | expect_set(sets[[1]], "one", 9) 15 | expect_set(sets[[2]], "three", 9) 16 | expect_set(sets[[3]], "two", 5) 17 | 18 | cc <- u %>% getCombinations() 19 | expect_equal(length(cc), 7) 20 | expect_set(cc[[1]], "one", 9) 21 | expect_set(cc[[2]], "three", 9) 22 | expect_set(cc[[3]], "two", 5) 23 | expect_set(cc[[4]], "one&three", 6) 24 | expect_set(cc[[5]], "one&two", 3) 25 | expect_set(cc[[6]], "three&two", 3) 26 | expect_set(cc[[7]], "one&three&two", 2) 27 | }) 28 | 29 | test_that("fromList - union", { 30 | listInput <- list(one = c("a", "b", "c", "e", "g", "h", "k", "l", "m"), two = c("a", "b", "d", "e", "j"), three = c("a", "e", "f", "g", "h", "i", "j", "l", "m")) 31 | 32 | u <- upsetjs_mock() %>% fromList(listInput, order.by = "degree", c_type = "union") 33 | sets <- u %>% getSets() 34 | expect_equal(length(sets), 3) 35 | expect_set(sets[[1]], "one", 9) 36 | expect_set(sets[[2]], "three", 9) 37 | expect_set(sets[[3]], "two", 5) 38 | 39 | cc <- u %>% getCombinations() 40 | expect_equal(length(cc), 7) 41 | expect_set(cc[[1]], "one", 9) 42 | expect_set(cc[[2]], "three", 9) 43 | expect_set(cc[[3]], "two", 5) 44 | expect_set(cc[[4]], "one&three", 12) 45 | expect_set(cc[[5]], "one&two", 11) 46 | expect_set(cc[[6]], "three&two", 11) 47 | expect_set(cc[[7]], "one&three&two", 13) 48 | }) 49 | 50 | test_that("fromList - distinctIntersection", { 51 | listInput <- list(one = c("a", "b", "c", "e", "g", "h", "k", "l", "m"), two = c("a", "b", "d", "e", "j"), three = c("a", "e", "f", "g", "h", "i", "j", "l", "m")) 52 | 53 | u <- upsetjs_mock() %>% fromList(listInput, order.by = "degree", c_type = "distinctIntersection") 54 | sets <- u %>% getSets() 55 | expect_equal(length(sets), 3) 56 | expect_set(sets[[1]], "one", 9) 57 | expect_set(sets[[2]], "three", 9) 58 | expect_set(sets[[3]], "two", 5) 59 | 60 | cc <- u %>% getCombinations() 61 | expect_equal(length(cc), 7) 62 | expect_set(cc[[1]], "one", 2) 63 | expect_set(cc[[2]], "three", 2) 64 | expect_set(cc[[3]], "two", 1) 65 | expect_set(cc[[4]], "one&three", 4) 66 | expect_set(cc[[5]], "one&two", 1) 67 | expect_set(cc[[6]], "three&two", 1) 68 | expect_set(cc[[7]], "one&three&two", 2) 69 | }) 70 | 71 | test_that("fromExpression", { 72 | expressionInput <- list(one = 9, two = 5, three = 9, `one&two` = 3, `one&three` = 6, `two&three` = 3, `one&two&three` = 2) 73 | 74 | u <- upsetjs_mock() %>% fromExpression(expressionInput, order.by = "degree") 75 | sets <- u %>% getSets() 76 | expect_equal(length(sets), 3) 77 | expect_set(sets[[1]], "one", 9, check.length = FALSE) 78 | expect_set(sets[[2]], "three", 9, check.length = FALSE) 79 | expect_set(sets[[3]], "two", 5, check.length = FALSE) 80 | 81 | cc <- u %>% getCombinations() 82 | expect_equal(length(cc), 7) 83 | expect_set(cc[[1]], "one", 9, check.length = FALSE) 84 | expect_set(cc[[2]], "three", 9, check.length = FALSE) 85 | expect_set(cc[[3]], "two", 5, check.length = FALSE) 86 | expect_set(cc[[4]], "one&three", 6, check.length = FALSE) 87 | expect_set(cc[[5]], "one&two", 3, check.length = FALSE) 88 | expect_set(cc[[6]], "two&three", 3, check.length = FALSE) 89 | expect_set(cc[[7]], "one&two&three", 2, check.length = FALSE) 90 | }) 91 | 92 | test_that("fromDataFrame", { 93 | dataFrame <- as.data.frame(list( 94 | one = c(1, 1, 1, 0, 1, 0, 1, 1, 0, 0, 1, 1, 1), 95 | two = c(1, 1, 0, 1, 1, 0, 0, 0, 0, 1, 0, 0, 0), 96 | three = c(1, 0, 0, 0, 1, 1, 1, 1, 1, 1, 0, 1, 1) 97 | ), 98 | row.names = c("a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m") 99 | ) 100 | 101 | u <- upsetjs_mock() %>% fromDataFrame(dataFrame, order.by = "degree") 102 | sets <- u %>% getSets() 103 | expect_equal(length(sets), 3) 104 | expect_set(sets[[1]], "one", 9) 105 | expect_set(sets[[2]], "three", 9) 106 | expect_set(sets[[3]], "two", 5) 107 | 108 | cc <- u %>% getCombinations() 109 | expect_equal(length(cc), 7) 110 | expect_set(cc[[1]], "one", 9) 111 | expect_set(cc[[2]], "three", 9) 112 | expect_set(cc[[3]], "two", 5) 113 | expect_set(cc[[4]], "one&three", 6) 114 | expect_set(cc[[5]], "one&two", 3) 115 | expect_set(cc[[6]], "three&two", 3) 116 | expect_set(cc[[7]], "one&three&two", 2) 117 | }) 118 | 119 | test_that("fromDataFrame - union", { 120 | dataFrame <- as.data.frame(list( 121 | one = c(1, 1, 1, 0, 1, 0, 1, 1, 0, 0, 1, 1, 1), 122 | two = c(1, 1, 0, 1, 1, 0, 0, 0, 0, 1, 0, 0, 0), 123 | three = c(1, 0, 0, 0, 1, 1, 1, 1, 1, 1, 0, 1, 1) 124 | ), 125 | row.names = c("a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m") 126 | ) 127 | 128 | u <- upsetjs_mock() %>% fromDataFrame(dataFrame, order.by = "degree", c_type = "union") 129 | sets <- u %>% getSets() 130 | expect_equal(length(sets), 3) 131 | expect_set(sets[[1]], "one", 9) 132 | expect_set(sets[[2]], "three", 9) 133 | expect_set(sets[[3]], "two", 5) 134 | 135 | cc <- u %>% getCombinations() 136 | expect_equal(length(cc), 7) 137 | expect_set(cc[[1]], "one", 9) 138 | expect_set(cc[[2]], "three", 9) 139 | expect_set(cc[[3]], "two", 5) 140 | expect_set(cc[[4]], "one&three", 12) 141 | expect_set(cc[[5]], "one&two", 11) 142 | expect_set(cc[[6]], "three&two", 11) 143 | expect_set(cc[[7]], "one&three&two", 13) 144 | }) 145 | 146 | test_that("fromDataFrame - distinctIntersection", { 147 | dataFrame <- as.data.frame(list( 148 | one = c(1, 1, 1, 0, 1, 0, 1, 1, 0, 0, 1, 1, 1), 149 | two = c(1, 1, 0, 1, 1, 0, 0, 0, 0, 1, 0, 0, 0), 150 | three = c(1, 0, 0, 0, 1, 1, 1, 1, 1, 1, 0, 1, 1) 151 | ), 152 | row.names = c("a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m") 153 | ) 154 | 155 | u <- upsetjs_mock() %>% fromDataFrame(dataFrame, c_type = "distinctIntersection", order.by = "degree") 156 | sets <- u %>% getSets() 157 | expect_equal(length(sets), 3) 158 | expect_set(sets[[1]], "one", 9) 159 | expect_set(sets[[2]], "three", 9) 160 | expect_set(sets[[3]], "two", 5) 161 | 162 | cc <- u %>% getCombinations() 163 | expect_equal(length(cc), 7) 164 | expect_set(cc[[1]], "one", 2) 165 | expect_set(cc[[2]], "three", 2) 166 | expect_set(cc[[3]], "two", 1) 167 | expect_set(cc[[4]], "one&three", 4) 168 | expect_set(cc[[5]], "one&two", 1) 169 | expect_set(cc[[6]], "three&two", 1) 170 | expect_set(cc[[7]], "one&three&two", 2) 171 | }) 172 | -------------------------------------------------------------------------------- /tests/testthat/test-toyset1.R: -------------------------------------------------------------------------------- 1 | # 2 | # @upsetjs/r 3 | # https://github.com/upsetjs/upsetjs_r 4 | # 5 | # Copyright (c) 2021 Samuel Gratzl 6 | # 7 | 8 | toyset_1 <- as.data.frame(read.delim( 9 | file = testthat::test_path("data", "toyset_1.tsv.gz"), 10 | sep = "\t" 11 | ))[, 1:6] 12 | 13 | 14 | test_that("toyset1 distinct", { 15 | expect_equal(nrow(toyset_1), 24152) 16 | expect_equal(ncol(toyset_1), 6) 17 | 18 | u <- upsetjs_mock() %>% fromDataFrame(toyset_1, c_type = "distinctIntersection") 19 | 20 | sets <- u %>% getSets() 21 | expect_equal(length(sets), 6) 22 | 23 | combinations <- u %>% getCombinations() 24 | expect_equal(length(combinations), 37) 25 | }) 26 | 27 | test_that("toyset1 intersection", { 28 | expect_equal(nrow(toyset_1), 24152) 29 | expect_equal(ncol(toyset_1), 6) 30 | 31 | u <- upsetjs_mock() %>% fromDataFrame(toyset_1, c_type = "intersection") 32 | 33 | sets <- u %>% getSets() 34 | expect_equal(length(sets), 6) 35 | 36 | combinations <- u %>% getCombinations() 37 | expect_equal(length(combinations), 63) 38 | }) 39 | -------------------------------------------------------------------------------- /tests/testthat/test-toyset2.R: -------------------------------------------------------------------------------- 1 | # 2 | # @upsetjs/r 3 | # https://github.com/upsetjs/upsetjs_r 4 | # 5 | # Copyright (c) 2021 Samuel Gratzl 6 | # 7 | 8 | toyset_2 <- as.data.frame(read.delim( 9 | file = testthat::test_path("data", "toyset_2.tsv.gz"), 10 | sep = "\t" 11 | )) 12 | 13 | # test_that("toyset_2 distinct", { 14 | # u = upsetjs_mock() %>% fromDataFrame(toyset_2, c_type = 'distinctIntersection') 15 | # sets = u %>% getSets() 16 | # expect_equal(length(sets), 7) 17 | # }) 18 | 19 | # test_that("toyset_2 intersection", { 20 | # u = upsetjs_mock() %>% fromDataFrame(toyset_2, c_type = 'intersection') 21 | # sets = u %>% getSets() 22 | # expect_equal(length(sets), 7) 23 | # }) 24 | -------------------------------------------------------------------------------- /tsconfig.json: -------------------------------------------------------------------------------- 1 | { 2 | "include": ["js", "types", "test"], 3 | "compilerOptions": { 4 | "target": "es6", 5 | "rootDir": "./", 6 | "baseUrl": "./", 7 | "paths": { 8 | "@": ["./"], 9 | "*": ["js/*", "node_modules/*"] 10 | }, 11 | "module": "esnext", 12 | "lib": ["dom", "esnext"], 13 | "importHelpers": true, 14 | "sourceMap": true, 15 | "strict": true, 16 | "importsNotUsedAsValues": "remove", 17 | "experimentalDecorators": true, 18 | "forceConsistentCasingInFileNames": true, 19 | "strictBindCallApply": true, 20 | "noImplicitAny": true, 21 | "strictNullChecks": true, 22 | "strictFunctionTypes": true, 23 | "strictPropertyInitialization": true, 24 | "noImplicitThis": true, 25 | "alwaysStrict": true, 26 | "noUnusedLocals": true, 27 | "noUnusedParameters": true, 28 | "noImplicitReturns": true, 29 | "noFallthroughCasesInSwitch": true, 30 | "moduleResolution": "node", 31 | "esModuleInterop": true, 32 | "jsx": "react" 33 | } 34 | } 35 | -------------------------------------------------------------------------------- /types/index.d.ts: -------------------------------------------------------------------------------- 1 | declare type HTMLWidget = { 2 | name: string; 3 | type: 'output'; 4 | factory( 5 | el: HTMLElement, 6 | width: number, 7 | height: number 8 | ): { 9 | renderValue(x: any): void; 10 | resize(width: number, height: number): void; 11 | }; 12 | }; 13 | 14 | declare const HTMLWidgets: { 15 | shinyMode: boolean; 16 | viewerMode: boolean; 17 | widget(widget: HTMLWidget): void; 18 | }; 19 | 20 | declare const Shiny: { 21 | onInputChange(event: string, msg: any): void; 22 | addCustomMessageHandler(type: string, callback: (msg: any) => void): void; 23 | }; 24 | 25 | declare class SelectionHandle { 26 | setGroup(group: string): void; 27 | on( 28 | event: 'change', 29 | callback: (event: { 30 | value?: ReadonlyArray; 31 | oldValue: ReadonlyArray; 32 | sender: SelectionHandle; 33 | }) => void 34 | ): any; 35 | off( 36 | event: 'change', 37 | callback: (event: { 38 | value?: ReadonlyArray; 39 | oldValue: ReadonlyArray; 40 | sender: SelectionHandle; 41 | }) => void 42 | ): void; 43 | 44 | readonly value: ReadonlyArray; 45 | set(selection: ReadonlyArray): void; 46 | clear(): void; 47 | } 48 | 49 | declare class FilterHandle { 50 | setGroup(group: string): void; 51 | on( 52 | event: 'change', 53 | callback: (event: { 54 | value?: ReadonlyArray; 55 | oldValue: ReadonlyArray; 56 | sender: SelectionHandle; 57 | }) => void 58 | ): any; 59 | off( 60 | event: 'change', 61 | callback: (event: { 62 | value?: ReadonlyArray; 63 | oldValue: ReadonlyArray; 64 | sender: SelectionHandle; 65 | }) => void 66 | ): void; 67 | 68 | readonly filteredKeys: ReadonlyArray; 69 | set(filter: ReadonlyArray): void; 70 | clear(): void; 71 | } 72 | 73 | declare const crosstalk: { 74 | SelectionHandle: typeof SelectionHandle; 75 | FilterHandle: typeof FilterHandle; 76 | }; 77 | -------------------------------------------------------------------------------- /upsetjs.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: No 4 | SaveWorkspace: No 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 | PackageRoxygenize: rd,collate,namespace 22 | -------------------------------------------------------------------------------- /vignettes/colors.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "UpSet.js Coloring" 3 | author: "Samuel Gratzl" 4 | date: "`r Sys.Date()`" 5 | output: rmarkdown::html_vignette 6 | vignette: > 7 | %\VignetteIndexEntry{UpSet.js Coloring} 8 | %\VignetteEngine{knitr::rmarkdown} 9 | \usepackage[utf8]{inputenc} 10 | --- 11 | 12 | ```{r setup, include=FALSE} 13 | knitr::opts_chunk$set(echo = TRUE) 14 | ``` 15 | 16 | # UpSet.js R Widget - Coloring Diagrams 17 | 18 | UpSet.js allow you to color sets in UpSet plots and Venn diagrams. 19 | 20 | ```{r libraries} 21 | # devtools::install_url("https://github.com/upsetjs/upsetjs_r/releases/latest/download/upsetjs.tar.gz") 22 | library(upsetjs) 23 | ``` 24 | 25 | ## Basic User Interface 26 | 27 | ```{r} 28 | listInput <- list(s1 = c('a', 'b', 'c', 'e', 'g', 'h', 'k', 'l', 'm'), s2 = c('a', 'b', 'd', 'e', 'j'), s3 = c('a', 'e', 'f', 'g', 'h', 'i', 'j', 'l', 'm')) 29 | colors <- list(s1 = '#1f77b4', s2 = '#2ca02c', s3 = '#d62728', `s1&s2` = '#9467bd', `s1&s3` = '#8c564b', `s2&s3` = '#e377c2', `s1&s2&s3` = '#bcbd22') 30 | 31 | render <- function(upsetjs) { 32 | upsetjs %>% fromList(listInput, colors=colors) %>% chartTheme(selection.color="", has.selection.opacity=0.3) %>% interactiveChart() 33 | } 34 | ``` 35 | 36 | 37 | ```{r, fig.width=9, fig.height=5, out.width="850px", tidy=TRUE, fig.align='center'} 38 | v <- upsetjs() %>% render() 39 | v 40 | ``` 41 | 42 | ```{r, fig.width=9, fig.height=5, out.width="850px", tidy=TRUE, fig.align='center'} 43 | v <- upsetjsVennDiagram() %>% render() 44 | v 45 | ``` 46 | 47 | ```{r, fig.width=9, fig.height=5, out.width="850px", tidy=TRUE, fig.align='center'} 48 | v <- upsetjsEulerDiagram() %>% render() 49 | v 50 | ``` 51 | -------------------------------------------------------------------------------- /vignettes/combinationModes.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "UpSet.js Combination Modes" 3 | author: "Samuel Gratzl" 4 | date: "`r Sys.Date()`" 5 | output: rmarkdown::html_vignette 6 | vignette: > 7 | %\VignetteIndexEntry{UpSet.js Combination Modes} 8 | %\VignetteEngine{knitr::rmarkdown} 9 | %\VignetteDepends{tibble} 10 | \usepackage[utf8]{inputenc} 11 | --- 12 | 13 | ```{r setup, include=FALSE} 14 | knitr::opts_chunk$set(echo = TRUE) 15 | ``` 16 | 17 | # UpSet.js Combination Modes 18 | 19 | ```{r} 20 | library(upsetjs) 21 | library(tibble) 22 | ``` 23 | 24 | ```{r} 25 | t <- tribble( 26 | ~set1, ~set2, ~set3, 27 | 1, 1, 0, 28 | 0, 0, 1, 29 | 0, 1, 1, 30 | 0, 0, 1, 31 | 0, 0, 1, 32 | 0, 1, 1, 33 | 1, 0, 1, 34 | 0, 1, 1, 35 | 0, 0, 1, 36 | 0, 0, 1, 37 | 1, 1, 1, 38 | 1, 0, 0, 39 | 0, 0, 1, 40 | 0, 1, 0, 41 | 1, 1, 1, 42 | 0, 1, 0, 43 | 0, 1, 1, 44 | 0, 1, 0, 45 | 0, 0, 1, 46 | 0, 0, 1 47 | ) 48 | ``` 49 | 50 | ## Intersection Mode 51 | 52 | ```{r, fig.width=9, fig.height=5, out.width="850px",tidy=TRUE, fig.align='center'} 53 | 54 | upsetjs() %>% fromDataFrame(t) %>% generateIntersections() 55 | ``` 56 | 57 | ## Union Mode 58 | 59 | ```{r, fig.width=9, fig.height=5, out.width="850px",tidy=TRUE, fig.align='center'} 60 | 61 | upsetjs() %>% fromDataFrame(t) %>% generateUnions() 62 | ``` 63 | 64 | ## Distinct Intersection Mode 65 | 66 | ```{r, fig.width=9, fig.height=5, out.width="850px",tidy=TRUE, fig.align='center'} 67 | 68 | upsetjs() %>% fromDataFrame(t) %>% generateDistinctIntersections() 69 | ``` 70 | -------------------------------------------------------------------------------- /vignettes/got.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "UpSet.js Comparison" 3 | author: "Samuel Gratzl" 4 | date: "`r Sys.Date()`" 5 | output: rmarkdown::html_vignette 6 | vignette: > 7 | %\VignetteIndexEntry{UpSet.js Comparison} 8 | %\VignetteEngine{knitr::rmarkdown} 9 | \usepackage[utf8]{inputenc} 10 | --- 11 | 12 | ```{r setup, include=FALSE} 13 | knitr::opts_chunk$set(echo = TRUE) 14 | ``` 15 | 16 | # UpSet.js Comparsion 17 | 18 | ```{r libraries} 19 | # devtools::install_url("https://github.com/upsetjs/upsetjs_r/releases/latest/download/upsetjs.tar.gz") 20 | library(upsetjs) 21 | ``` 22 | 23 | Load the included Game of Thrones dataset 24 | 25 | ```{r data} 26 | data(got) 27 | got 28 | ``` 29 | 30 | ## UpSet Plot 31 | 32 | ```{r, fig.width=9, fig.height=5, out.width="850px", tidy=TRUE, fig.align='center'} 33 | upsetjs() %>% fromDataFrame(got) %>% interactiveChart() 34 | ``` 35 | 36 | ## Venn Diagram (5 sets at most) 37 | 38 | ```{r, fig.width=9, fig.height=5, out.width="850px", tidy=TRUE, fig.align='center'} 39 | upsetjsVennDiagram() %>% fromDataFrame(got) %>% interactiveChart() 40 | ``` 41 | 42 | ## Karnaugh Map 43 | 44 | ```{r, fig.width=9, fig.height=5, out.width="850px", tidy=TRUE, fig.align='center'} 45 | upsetjsKarnaughMap() %>% fromDataFrame(got) %>% interactiveChart() 46 | ``` 47 | -------------------------------------------------------------------------------- /vignettes/kmap.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "UpSet.js Karnaugh Map" 3 | author: "Samuel Gratzl" 4 | date: "`r Sys.Date()`" 5 | output: rmarkdown::html_vignette 6 | vignette: > 7 | %\VignetteIndexEntry{UpSet.js Karnaugh Map} 8 | %\VignetteEngine{knitr::rmarkdown} 9 | \usepackage[utf8]{inputenc} 10 | --- 11 | 12 | ```{r setup, include=FALSE} 13 | knitr::opts_chunk$set(echo = TRUE) 14 | ``` 15 | 16 | # UpSet.js R Widget - Karnaugh Map 17 | 18 | UpSet.js has a basic support for adapted version of Karnaugh Maps. 19 | 20 | ```{r libraries} 21 | # devtools::install_url("https://github.com/upsetjs/upsetjs_r/releases/latest/download/upsetjs.tar.gz") 22 | library(upsetjs) 23 | ``` 24 | 25 | ## Basic User Interface 26 | 27 | ```{r, fig.width=9, fig.height=5, out.width="850px", tidy=TRUE, fig.align='center'} 28 | listInput <- list(one = c('a', 'b', 'c', 'e', 'g', 'h', 'k', 'l', 'm'), two = c('a', 'b', 'd', 'e', 'j'), three = c('a', 'e', 'f', 'g', 'h', 'i', 'j', 'l', 'm')) 29 | 30 | w <- upsetjsKarnaughMap() %>% fromList(listInput) %>% interactiveChart() 31 | w 32 | ``` 33 | 34 | ## Input Formats 35 | 36 | same as for `upsetjs`: `fromList`, `fromDataFrame`, and `fromExpression` 37 | 38 | ## Data Intersections 39 | 40 | not possible to define since the number of sections in the Venn diagrams are fixed 41 | 42 | ## Interaction 43 | 44 | ### Interactivity 45 | 46 | same as `upsetjs` 47 | 48 | ### Selection 49 | 50 | same as `upsetjs` 51 | 52 | ## Queries 53 | 54 | same as `upsetjs` 55 | 56 | ## Attributes 57 | 58 | not supported 59 | 60 | ## Styling 61 | 62 | ### Theme 63 | 64 | same as `upsetjs` 65 | 66 | ### Title 67 | 68 | provided as a different function: `chartKarnaughMapLabels` 69 | 70 | ```{r, fig.width=9, fig.height=5, out.width="850px", tidy=TRUE, fig.align='center'} 71 | upsetjsKarnaughMap() %>% 72 | fromList(listInput) %>% 73 | chartKarnaughMapLabels(title = "Chart Title", description = "this is a long chart description") 74 | ``` 75 | 76 | -------------------------------------------------------------------------------- /vignettes/upsetjs.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Introduction to UpSet.js" 3 | author: "Samuel Gratzl" 4 | date: "`r Sys.Date()`" 5 | output: rmarkdown::html_vignette 6 | vignette: > 7 | %\VignetteIndexEntry{Introduction to UpSet.js} 8 | %\VignetteEngine{knitr::rmarkdown} 9 | \usepackage[utf8]{inputenc} 10 | --- 11 | 12 | ```{r setup, include=FALSE} 13 | knitr::opts_chunk$set(echo = TRUE) 14 | ``` 15 | 16 | # UpSet.js R Widget 17 | 18 | [UpSet.js](https://upset.js.org) is a JavaScript re-implementation of [UpSetR](https://www.rdocumentation.org/packages/UpSetR/) which itself is based on [UpSet](https://upset.app/). 19 | 20 | The core library is written in React but provides also bundle editions for plain JavaScript use and this R wrapper using [HTMLWidget](https://www.htmlwidgets.org/). 21 | 22 | In this tutorial the basic widget functionality is explained. 23 | 24 | Let's begin with importing the library 25 | 26 | ```{r libraries} 27 | # devtools::install_url("https://github.com/upsetjs/upsetjs_r/releases/latest/download/upsetjs.tar.gz") 28 | library(upsetjs) 29 | ``` 30 | 31 | ## Basic User Interface 32 | 33 | **Note**: The input data will be described in more detail in the next section 34 | 35 | example of list input (list of named vectors, each having a list of contained elements) 36 | 37 | ```{r, fig.width=9, fig.height=5, out.width="850px", tidy=TRUE, fig.align='center'} 38 | listInput <- list(one = c('a', 'b', 'c', 'e', 'g', 'h', 'k', 'l', 'm'), two = c('a', 'b', 'd', 'e', 'j'), three = c('a', 'e', 'f', 'g', 'h', 'i', 'j', 'l', 'm')) 39 | 40 | w <- upsetjs() %>% fromList(listInput) %>% interactiveChart() 41 | w 42 | ``` 43 | 44 | 45 | An UpSet plot consists of three areas: 46 | 47 | - The bottom left area shows the list of sets as a vertical bar chart. The length of the bar corresponds to the cardinality of the set, i.e., the number of elements in this set. 48 | - The top right area shows the list of set intersections as a horizontal bar chart. Again the length corresponds to the cardinality of the set 49 | - The bottom right area shows which intersection consists of which sets. A dark dot indicates that the set is part of this set intersection. The line connecting the dots is just to visually group the dots. 50 | 51 | Moving the mouse over a bar or a dot will automatically highlight the corresponding set or set intersection in orange. In addition, the number elements which are shared with the highlighted sets are also highlighted. This gives a quick overview how sets and set intersections are related to each other. More details, in the Interaction section. 52 | 53 | ## Input Formats 54 | 55 | In the current version the UpSet.js wrapper supports three input data formats: list, expression, and through a data.frame. 56 | 57 | ### List Input 58 | 59 | The first format is a list. The key of the list entry is the set name while the value is the vector of elements this set has. See also UpsetR 60 | 61 | ```{r, fig.width=9, fig.height=5, out.width="850px", tidy=TRUE, fig.align='center'} 62 | upsetjs() %>% fromList(list(one = c('a', 'b', 'c', 'e', 'g', 'h', 'k', 'l', 'm'), two = c('a', 'b', 'd', 'e', 'j'), three = c('a', 'e', 'f', 'g', 'h', 'i', 'j', 'l', 'm'))) 63 | ``` 64 | 65 | 66 | ### Expression Input 67 | 68 | The second version is a a variant in which not the elements are given but their cardinality. Thus, besides the sets also all the set intersections have to be defined. Moreover, this version has only limited interactivty support. 69 | 70 | ```{r, fig.width=9, fig.height=5, out.width="850px", tidy=TRUE, fig.align='center'} 71 | 72 | # example of expression input 73 | expressionInput <- list(one = 9, two = 5, three = 9, `one&two` = 3, `one&three` = 6, `two&three` = 3, `one&two&three` = 2) 74 | 75 | 76 | upsetjs() %>% fromExpression(expressionInput) %>% interactiveChart() 77 | ``` 78 | 79 | 80 | ### Data Frame Input 81 | 82 | The last format is a a binary/boolean data frame. The rownames contain the list of elements. Each regular column represents a set with boolean values (e.g., 0 and 1) whether the row represented by the rowname is part of the set or not. 83 | 84 | The following data frame defines the same set structure as the dictionary format before. 85 | ```{r, fig.width=9, fig.height=5, out.width="850px", tidy=TRUE, fig.align='center'} 86 | 87 | # boolean table with rows = elements, columns = sets, cell = is row part of this set 88 | dataFrame <- as.data.frame(list( 89 | one=c(1, 1, 1, 0, 1, 0, 1, 1, 0, 0, 1, 1, 1), 90 | two=c(1, 1, 0, 1, 1, 0, 0, 0, 0, 1, 0, 0, 0), 91 | three=c(1, 0, 0, 0, 1, 1, 1, 1, 1, 1, 0, 1, 1)), 92 | row.names=c('a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm')) 93 | 94 | 95 | upsetjs() %>% fromDataFrame(dataFrame) 96 | ``` 97 | 98 | ## Data Intersections 99 | 100 | In case of an `expressionInput` the combinations of sets are directly given. 101 | 102 | `generateIntersections`, `generateDistinctIntersections`, and `generateUnions` let you customize the generation of the set combinations 103 | 104 | - `min` ... minimum number of sets in a set combination 105 | - `max` ... maximum number of sets in a set combination, NULL means no limit 106 | - `empty` ... include empty set combinations with no elements. By default they are not included 107 | - `order.by` ... sort set combinations either by `cardinality` (number of elements) or by `degree` (number of sets 108 | - `limit` ... show only the first limit set combinations 109 | 110 | 111 | ```{r, fig.width=9, fig.height=5, out.width="850px", tidy=TRUE, fig.align='center'} 112 | 113 | upsetjs() %>% fromList(listInput) %>% 114 | generateDistinctIntersections() 115 | ``` 116 | 117 | ```{r, fig.width=9, fig.height=5, out.width="850px", tidy=TRUE, fig.align='center'} 118 | 119 | upsetjs() %>% fromList(listInput) %>% 120 | generateIntersections(min=2, max=NULL, empty=T, order.by='cardinality', limit=NULL) 121 | ``` 122 | 123 | ```{r, fig.width=9, fig.height=5, out.width="850px", tidy=TRUE, fig.align='center'} 124 | 125 | upsetjs() %>% fromList(listInput) %>% 126 | generateUnions(min=0, max=2, empty=T, order.by='degree', limit=NULL) 127 | ``` 128 | 129 | ## Interaction 130 | 131 | ### Interactivity 132 | by setting the `interactiveFlag` flag, the user can interactively highlight sets within the chart. 133 | 134 | ```{r, fig.width=9, fig.height=5, out.width="850px", tidy=TRUE, fig.align='center'} 135 | upsetjs() %>% 136 | fromList(listInput) %>% 137 | interactiveChart() 138 | ``` 139 | 140 | ### Selection 141 | with `setSelection` one manually sets the selection that is currently highlighted. The set is referenced by its name, a vector with multiple names is detected as an intersection name 142 | 143 | 144 | ```{r, fig.width=9, fig.height=5, out.width="850px", tidy=TRUE, fig.align='center'} 145 | upsetjs() %>% 146 | fromList(listInput) %>% 147 | setSelection("one") 148 | ``` 149 | 150 | 151 | ```{r, fig.width=9, fig.height=5, out.width="850px", tidy=TRUE, fig.align='center'} 152 | upsetjs() %>% 153 | fromList(listInput) %>% 154 | setSelection(c("one", "two")) 155 | ``` 156 | 157 | In case UpSet.js will be used in a R Shiny context, it reports the current selection based using two custom events: 158 | 159 | - `_hover` when the user hovers over an item 160 | - `_click` when the user clicks on an item 161 | - `_contextMenu` when the user right clicks on an item 162 | 163 | both events are list objects with a `name` attribute that is either `NULL` or the name of the set. In addition, there is an `elems` attribute which contains the list of highlighted elements. 164 | 165 | See also Shiny examples at [events.R](https://github.com/upsetjs/upsetjs_r/blob/main/shiny/events.R) 166 | 167 | 168 | ## Queries 169 | 170 | besides the selection UpSet.js supports defining queries. A query can be a list of elements or a set that should be highlighted. A query consists of a name, a color, and either the list of elements or the set (combination) to highlight. 171 | 172 | 173 | ```{r, fig.width=9, fig.height=5, out.width="850px", tidy=TRUE, fig.align='center'} 174 | upsetjs() %>% 175 | fromList(listInput) %>% 176 | addQuery("Q1", color="red", elems=c('a', 'b', 'c')) %>% 177 | addQuery("Q2", color="blue", set='two') 178 | ``` 179 | 180 | 181 | ## Attributes 182 | 183 | UpSet.js supports rendering boxplots as aggregations for numerical attributes of elements and mosaic plots for categorical attributes. 184 | The are given as part of the data frame. The attributes element has to be a list or a data frame. 185 | 186 | 187 | ```{r, fig.width=9, fig.height=5, out.width="850px", tidy=TRUE, fig.align='center'} 188 | dataFrame <- as.data.frame(list( 189 | one=c(1, 1, 1, 0, 1, 0, 1, 1, 0, 0, 1, 1, 1), 190 | two=c(1, 1, 0, 1, 1, 0, 0, 0, 0, 1, 0, 0, 0), 191 | three=c(1, 0, 0, 0, 1, 1, 1, 1, 1, 1, 0, 1, 1)), 192 | row.names=c('a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm')) 193 | 194 | upsetjs() %>% 195 | fromDataFrame(dataFrame, attributes = list(attr=runif(nrow(dataFrame)))) 196 | ``` 197 | 198 | 199 | ## Styling 200 | 201 | ### Theme 202 | 203 | UpSet.js supports thre themes: light, dark, and vega. The theme can be set by the `chartTheme` function 204 | 205 | ```{r, fig.width=9, fig.height=5, out.width="850px", tidy=TRUE, fig.align='center'} 206 | upsetjs() %>% 207 | fromList(listInput) %>% 208 | chartTheme('dark') 209 | ``` 210 | 211 | ### Title 212 | 213 | ```{r, fig.width=9, fig.height=5, out.width="850px", tidy=TRUE, fig.align='center'} 214 | upsetjs() %>% 215 | fromList(listInput) %>% 216 | chartLabels(title = "Chart Title", description = "this is a long chart description") 217 | ``` 218 | 219 | ### Labels 220 | 221 | ```{r, fig.width=9, fig.height=5, out.width="850px", tidy=TRUE, fig.align='center'} 222 | upsetjs() %>% 223 | fromList(listInput) %>% 224 | chartLabels(combination.name = "Combination Label", set.name = "Set Label") 225 | ``` 226 | 227 | ### Log Scale 228 | 229 | setting `chartLayout(numerical.scale = 'log')` switches to a log scale, similarly `'linear'` goes back to a linear scale 230 | 231 | ```{r, fig.width=9, fig.height=5, out.width="850px", tidy=TRUE, fig.align='center'} 232 | upsetjs() %>% 233 | fromList(listInput) %>% 234 | chartLayout(numerical.scale = 'log') 235 | ``` 236 | -------------------------------------------------------------------------------- /vignettes/venn.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "UpSet.js Venn and Euler Diagrams" 3 | author: "Samuel Gratzl" 4 | date: "`r Sys.Date()`" 5 | output: rmarkdown::html_vignette 6 | vignette: > 7 | %\VignetteIndexEntry{UpSet.js Venn and Euler Diagrams} 8 | %\VignetteEngine{knitr::rmarkdown} 9 | \usepackage[utf8]{inputenc} 10 | --- 11 | 12 | ```{r setup, include=FALSE} 13 | knitr::opts_chunk$set(echo = TRUE) 14 | ``` 15 | 16 | # UpSet.js R Widget - Venn Diagrams 17 | 18 | UpSet.js has a basic support for classical Venn and Euler diagrams for two or three sets. 19 | 20 | ```{r libraries} 21 | # devtools::install_url("https://github.com/upsetjs/upsetjs_r/releases/latest/download/upsetjs.tar.gz") 22 | library(upsetjs) 23 | ``` 24 | 25 | ## Basic User Interface 26 | 27 | ```{r, fig.width=9, fig.height=5, out.width="850px", tidy=TRUE, fig.align='center'} 28 | listInput <- list(one = c('a', 'b', 'c', 'e', 'g', 'h', 'k', 'l', 'm'), two = c('a', 'b', 'd', 'e', 'j'), three = c('a', 'e', 'f', 'g', 'h', 'i', 'j', 'l', 'm')) 29 | 30 | w <- upsetjsVennDiagram() %>% fromList(listInput) %>% interactiveChart() 31 | w 32 | ``` 33 | 34 | Euler diagrams are based on [venn.js](https://github.com/upsetjs/venn.js) 35 | thus supporting more than three sets but might result in unexpected results 36 | 37 | ```{r, fig.width=9, fig.height=5, out.width="850px", tidy=TRUE, fig.align='center'} 38 | we <- upsetjsEulerDiagram() %>% fromList(listInput) %>% interactiveChart() 39 | we 40 | ``` 41 | 42 | ## Input Formats 43 | 44 | same as for `upsetjs`: `fromList`, `fromDataFrame`, and `fromExpression` 45 | 46 | ## Data Intersections 47 | 48 | not possible to define since the number of sections in the Venn diagrams are fixed 49 | 50 | ## Interaction 51 | 52 | ### Interactivity 53 | 54 | same as `upsetjs` 55 | 56 | ### Selection 57 | 58 | same as `upsetjs` 59 | 60 | ## Queries 61 | 62 | same as `upsetjs` 63 | 64 | ## Attributes 65 | 66 | not supported 67 | 68 | ## Styling 69 | 70 | ### Theme 71 | 72 | same as `upsetjs` 73 | 74 | ### Title 75 | 76 | provided as a different function: `chartVennLabels` 77 | 78 | ```{r, fig.width=9, fig.height=5, out.width="850px", tidy=TRUE, fig.align='center'} 79 | upsetjsVennDiagram() %>% 80 | fromList(listInput) %>% 81 | chartVennLabels(title = "Chart Title", description = "this is a long chart description") 82 | ``` 83 | 84 | -------------------------------------------------------------------------------- /webpack.config.js: -------------------------------------------------------------------------------- 1 | const path = require('path'); 2 | const pkg = require('./package.json'); 3 | const PnpWebpackPlugin = require('pnp-webpack-plugin'); 4 | 5 | const babel = { 6 | loader: require.resolve('babel-loader'), 7 | options: { 8 | cacheDirectory: true, 9 | presets: [ 10 | [ 11 | '@babel/preset-env', 12 | { 13 | targets: pkg.browserslist, 14 | useBuiltIns: 'entry', 15 | corejs: pkg.dependencies['core-js'], 16 | }, 17 | ], 18 | ], 19 | }, 20 | }; 21 | 22 | module.exports = [ 23 | { 24 | entry: { 25 | app: './js/htmlwidget.ts', 26 | }, 27 | output: { 28 | filename: 'upsetjs.js', 29 | path: path.resolve(__dirname, 'inst', 'htmlwidgets'), 30 | }, 31 | module: { 32 | rules: [ 33 | { 34 | test: /\.tsx?$/, 35 | use: [ 36 | babel, 37 | { 38 | loader: require.resolve('ts-loader'), 39 | }, 40 | ], 41 | }, 42 | { 43 | test: /\.js?$/, 44 | use: [babel], 45 | }, 46 | ], 47 | }, 48 | plugins: [], 49 | resolve: { 50 | extensions: ['.ts', '.tsx', '.js'], 51 | alias: { '@': path.resolve(__dirname) }, 52 | plugins: [PnpWebpackPlugin], 53 | }, 54 | resolveLoader: { 55 | plugins: [PnpWebpackPlugin.moduleLoader(module)], 56 | }, 57 | }, 58 | { 59 | entry: { 60 | app: './js/dash.tsx', 61 | }, 62 | output: { 63 | filename: 'upsetjs.js', 64 | path: path.resolve(__dirname, 'inst', 'dash'), 65 | library: 'upsetjs', 66 | libraryTarget: 'window', 67 | }, 68 | module: { 69 | rules: [ 70 | { 71 | test: /\.tsx?$/, 72 | use: [ 73 | babel, 74 | { 75 | loader: require.resolve('ts-loader'), 76 | }, 77 | ], 78 | }, 79 | { 80 | test: /\.js?$/, 81 | use: [babel], 82 | }, 83 | ], 84 | }, 85 | plugins: [], 86 | externals: { 87 | react: 'React', 88 | 'react-dom': 'ReactDOM', 89 | 'plotly.js': 'Plotly', 90 | 'prop-types': 'PropTypes', 91 | }, 92 | resolve: { 93 | extensions: ['.ts', '.tsx', '.js'], 94 | alias: { '@': path.resolve(__dirname) }, 95 | plugins: [PnpWebpackPlugin], 96 | }, 97 | resolveLoader: { 98 | plugins: [PnpWebpackPlugin.moduleLoader(module)], 99 | }, 100 | }, 101 | ]; 102 | --------------------------------------------------------------------------------