├── .github ├── .gitignore └── workflows │ ├── test-coverage.yaml │ ├── pkgdown.yaml │ └── R-CMD-check.yaml ├── examples ├── .gitignore ├── legend.R ├── labs.R ├── proxy-iteration.R ├── topogram.Rmd ├── proxy-labs.R ├── proxy-update.R ├── examples.R └── selectmenu.R ├── srcjs ├── config │ ├── misc.json │ ├── output_path.json │ ├── externals.json │ ├── entry_points.json │ └── loaders.json ├── index.js ├── modules │ ├── topogram.css │ ├── proxy.js │ ├── utils.js │ └── slimselect.min.css └── widgets │ ├── topogram_select.js │ └── topogram.js ├── vignettes ├── .gitignore └── topogram.Rmd ├── LICENSE ├── data ├── france.rda └── world.rda ├── data-raw ├── TCRD_027.xlsx ├── france.R └── world.R ├── man ├── figures │ └── topogram.png ├── topogRam-exports.Rd ├── france.Rd ├── topogRam-package.Rd ├── world.Rd ├── topogram_labs.Rd ├── topogRam-shiny.Rd ├── topogram_proxy_iteration.Rd ├── topogram_legend.Rd ├── topogRam.Rd ├── topogram_proxy_update.Rd └── topogram_select.Rd ├── .gitignore ├── tests └── tinytest.R ├── webpack.prod.js ├── webpack.dev.js ├── codecov.yml ├── .Rbuildignore ├── _pkgdown.yml ├── R ├── topogram-package.R ├── data.R ├── topogram_select.R ├── topogram.R ├── shiny.R ├── topo-extras.R └── utils.R ├── DESCRIPTION ├── LICENSE.md ├── NAMESPACE ├── package.json ├── inst ├── examples │ ├── nz-retail.R │ ├── proxy-vector │ │ └── app.R │ ├── proxy-vector2 │ │ └── app.R │ ├── france-pop.R │ ├── shiny-click │ │ └── app.R │ ├── projections.R │ ├── features.R │ ├── proxy-iteration │ │ └── app.R │ ├── proxy-value2 │ │ └── app.R │ ├── proxy-value │ │ └── app.R │ ├── eurostat-wine.R │ ├── eurostat-wine-rmd.Rmd │ └── eurostat-wine-app.R ├── tinytest │ ├── test_topogram.R │ └── test_utils.R └── htmlwidgets │ └── topogram_select.js ├── webpack.common.js └── README.md /.github/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | -------------------------------------------------------------------------------- /examples/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | -------------------------------------------------------------------------------- /srcjs/config/misc.json: -------------------------------------------------------------------------------- 1 | [] 2 | -------------------------------------------------------------------------------- /vignettes/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | *.R 3 | -------------------------------------------------------------------------------- /srcjs/config/output_path.json: -------------------------------------------------------------------------------- 1 | "./inst/htmlwidgets" 2 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2021 2 | COPYRIGHT HOLDER: Victor Perrier 3 | -------------------------------------------------------------------------------- /data/france.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dreamRs/topogram/HEAD/data/france.rda -------------------------------------------------------------------------------- /data/world.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dreamRs/topogram/HEAD/data/world.rda -------------------------------------------------------------------------------- /srcjs/index.js: -------------------------------------------------------------------------------- 1 | import './widgets/topogram.js' 2 | import './widgets/topogram_select.js' 3 | -------------------------------------------------------------------------------- /data-raw/TCRD_027.xlsx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dreamRs/topogram/HEAD/data-raw/TCRD_027.xlsx -------------------------------------------------------------------------------- /man/figures/topogram.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dreamRs/topogram/HEAD/man/figures/topogram.png -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | dev/ 5 | *.Rproj 6 | node_modules 7 | inst/doc 8 | docs 9 | -------------------------------------------------------------------------------- /srcjs/config/externals.json: -------------------------------------------------------------------------------- 1 | { 2 | "widgets": "HTMLWidgets", 3 | "2": "Shiny", 4 | "3": "jQuery" 5 | } 6 | -------------------------------------------------------------------------------- /tests/tinytest.R: -------------------------------------------------------------------------------- 1 | 2 | if ( requireNamespace("tinytest", quietly=TRUE) ){ 3 | tinytest::test_package("topogram") 4 | } 5 | 6 | -------------------------------------------------------------------------------- /srcjs/config/entry_points.json: -------------------------------------------------------------------------------- 1 | { 2 | "topogram": "./srcjs/widgets/topogram.js", 3 | "topogram_select": "./srcjs/widgets/topogram_select.js" 4 | } 5 | -------------------------------------------------------------------------------- /srcjs/config/loaders.json: -------------------------------------------------------------------------------- 1 | [ 2 | { 3 | "test": "\\.css$", 4 | "use": [ 5 | "style-loader", 6 | "css-loader" 7 | ] 8 | } 9 | ] 10 | -------------------------------------------------------------------------------- /webpack.prod.js: -------------------------------------------------------------------------------- 1 | const { merge } = require('webpack-merge'); 2 | const common = require('./webpack.common.js'); 3 | 4 | module.exports = merge(common, { 5 | mode: 'production', 6 | }); 7 | -------------------------------------------------------------------------------- /webpack.dev.js: -------------------------------------------------------------------------------- 1 | const { merge } = require('webpack-merge'); 2 | const common = require('./webpack.common.js'); 3 | 4 | module.exports = merge(common, { 5 | mode: 'development', 6 | devtool: 'inline-source-map' 7 | }); 8 | -------------------------------------------------------------------------------- /codecov.yml: -------------------------------------------------------------------------------- 1 | comment: false 2 | 3 | coverage: 4 | status: 5 | project: 6 | default: 7 | target: auto 8 | threshold: 1% 9 | informational: true 10 | patch: 11 | default: 12 | target: auto 13 | threshold: 1% 14 | informational: true 15 | -------------------------------------------------------------------------------- /examples/legend.R: -------------------------------------------------------------------------------- 1 | library(topogram) 2 | 3 | topogram(world, value = "pop_est") %>% 4 | topogram_legend(title = "Population") 5 | 6 | topogram(world, value = "pop_est", palette = "Blues") %>% 7 | topogram_legend( 8 | title = NULL, 9 | formatter = scales::label_comma(), 10 | direction = "v" 11 | ) 12 | -------------------------------------------------------------------------------- /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^data-raw$ 2 | ^\.travis\.yml$ 3 | ^.*\.Rproj$ 4 | ^\.Rproj\.user$ 5 | ^examples$ 6 | ^LICENSE\.md$ 7 | ^srcjs$ 8 | ^node_modules$ 9 | ^package\.json$ 10 | ^package-lock\.json$ 11 | ^webpack\.dev\.js$ 12 | ^webpack\.prod\.js$ 13 | ^webpack\.common\.js$ 14 | ^\.github$ 15 | ^codecov\.yml$ 16 | ^_pkgdown\.yml$ 17 | ^docs$ 18 | ^pkgdown$ 19 | -------------------------------------------------------------------------------- /examples/labs.R: -------------------------------------------------------------------------------- 1 | library(topogram) 2 | library(htmltools) 3 | 4 | topogram(world, "pop_est") %>% 5 | topogram_labs( 6 | title = "World population", 7 | subtitle = "Population estimate for 2017", 8 | caption = tagList( 9 | "Data source:", 10 | tags$a( 11 | href = "https://www.naturalearthdata.com/", 12 | "NaturalEarth" 13 | ) 14 | ) 15 | ) 16 | -------------------------------------------------------------------------------- /man/topogRam-exports.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/topogram-package.R 3 | \name{topogram-exports} 4 | \alias{topogram-exports} 5 | \alias{\%>\%} 6 | \title{topogram exported operators and S3 methods} 7 | \description{ 8 | The following functions are imported and then re-exported 9 | from the topogram package to avoid listing the magrittr 10 | as Depends of topogram 11 | } 12 | -------------------------------------------------------------------------------- /man/france.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/data.R 3 | \docType{data} 4 | \name{france} 5 | \alias{france} 6 | \title{France departments} 7 | \format{ 8 | An 'sf' object containing geometries and data. 9 | } 10 | \source{ 11 | Natural Earth (via package {rnaturalearth}) for polygons, INSEE for data. 12 | } 13 | \usage{ 14 | france 15 | } 16 | \description{ 17 | France departments with data about structure of total employment by major industry in 2019. 18 | } 19 | \keyword{datasets} 20 | -------------------------------------------------------------------------------- /man/topogRam-package.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/topogram-package.R 3 | \docType{package} 4 | \name{topogram-package} 5 | \alias{topogram-package} 6 | \title{An \code{htmlwidget} to create Continuous Cartogram in 'D3.js'} 7 | \description{ 8 | This package allow you to use cartogram-chart.js (\url{https://github.com/vasturiano/cartogram-chart}), 9 | an interactive contiguous cartogram reusable chart for visualizing geographical data. 10 | } 11 | \author{ 12 | Victor Perrier (@dreamRs_fr) 13 | } 14 | -------------------------------------------------------------------------------- /man/world.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/data.R 3 | \docType{data} 4 | \name{world} 5 | \alias{world} 6 | \title{World Countries} 7 | \format{ 8 | An 'sf' object containing geometries and data. 9 | } 10 | \source{ 11 | Natural Earth (via package {rnaturalearth}) for polygons, Our World In Data for CO2 and renewables electricity data. 12 | } 13 | \usage{ 14 | world 15 | } 16 | \description{ 17 | World countries with data such as population estimate, GDP, 18 | CO2 emissions and share of electricity production from renewables. 19 | } 20 | \keyword{datasets} 21 | -------------------------------------------------------------------------------- /_pkgdown.yml: -------------------------------------------------------------------------------- 1 | url: https://dreamrs.github.io/topogram 2 | 3 | template: 4 | bootstrap: 5 5 | bootswatch: zephyr 6 | bslib: 7 | base_font: {google: "Poppins"} 8 | primary: "#112446" 9 | 10 | navbar: 11 | bg: primary 12 | 13 | authors: 14 | Victor Perrier: 15 | href: https://twitter.com/_pvictorr 16 | html: Victor Perrier 17 | Fanny Meyer: 18 | href: https://twitter.com/_mfaan 19 | html: Fanny Meyer 20 | -------------------------------------------------------------------------------- /srcjs/modules/topogram.css: -------------------------------------------------------------------------------- 1 | /* topogram CSS */ 2 | .topogram-heading { 3 | position: absolute; 4 | top: 10px; 5 | left: 15px; 6 | } 7 | .topogram-title { 8 | font-weight: bold; 9 | font-size: 160%; 10 | } 11 | .topogram-subtitle { 12 | font-size: 110%; 13 | } 14 | .topogram-caption { 15 | position: absolute; 16 | bottom: 0; 17 | right: 15px; 18 | font-size: smaller; 19 | } 20 | .topogram-legend { 21 | position: absolute; 22 | bottom: 10px; 23 | left: 15px; 24 | } 25 | .topogram-legend-title { 26 | font-weight: bolder; 27 | } 28 | .topogram-legend-labels-v { 29 | margin-left: 12px; 30 | padding-left: 2px; 31 | position: relative; 32 | } 33 | .topogram-legend-labels-v-2 { 34 | position: absolute; 35 | bottom: 0; 36 | } 37 | -------------------------------------------------------------------------------- /R/topogram-package.R: -------------------------------------------------------------------------------- 1 | #' An \code{htmlwidget} to create Continuous Cartogram in 'D3.js' 2 | #' 3 | #' This package allow you to use cartogram-chart.js (\url{https://github.com/vasturiano/cartogram-chart}), 4 | #' an interactive contiguous cartogram reusable chart for visualizing geographical data. 5 | #' 6 | #' @name topogram-package 7 | #' @docType package 8 | #' @author Victor Perrier (@@dreamRs_fr) 9 | NULL 10 | 11 | #' topogram exported operators and S3 methods 12 | #' 13 | #' The following functions are imported and then re-exported 14 | #' from the topogram package to avoid listing the magrittr 15 | #' as Depends of topogram 16 | #' 17 | #' @name topogram-exports 18 | NULL 19 | 20 | #' @importFrom magrittr %>% 21 | #' @name %>% 22 | #' @export 23 | #' @rdname topogram-exports 24 | NULL 25 | -------------------------------------------------------------------------------- /R/data.R: -------------------------------------------------------------------------------- 1 | 2 | #' @title World Countries 3 | #' 4 | #' @description World countries with data such as population estimate, GDP, 5 | #' CO2 emissions and share of electricity production from renewables. 6 | #' 7 | #' @format An 'sf' object containing geometries and data. 8 | #' 9 | #' @keywords datasets 10 | #' 11 | #' @source Natural Earth (via package {rnaturalearth}) for polygons, Our World In Data for CO2 and renewables electricity data. 12 | "world" 13 | 14 | 15 | #' @title France departments 16 | #' 17 | #' @description France departments with data about structure of total employment by major industry in 2019. 18 | #' 19 | #' @format An 'sf' object containing geometries and data. 20 | #' 21 | #' @keywords datasets 22 | #' 23 | #' @source Natural Earth (via package {rnaturalearth}) for polygons, INSEE for data. 24 | "france" 25 | -------------------------------------------------------------------------------- /.github/workflows/test-coverage.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/master/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | pull_request: 7 | branches: [main, master] 8 | 9 | name: test-coverage 10 | 11 | jobs: 12 | test-coverage: 13 | runs-on: ubuntu-latest 14 | env: 15 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 16 | 17 | steps: 18 | - uses: actions/checkout@v2 19 | 20 | - uses: r-lib/actions/setup-r@v1 21 | with: 22 | use-public-rspm: true 23 | 24 | - uses: r-lib/actions/setup-r-dependencies@v1 25 | with: 26 | extra-packages: covr 27 | 28 | - name: Test coverage 29 | run: covr::codecov() 30 | shell: Rscript {0} 31 | -------------------------------------------------------------------------------- /examples/proxy-iteration.R: -------------------------------------------------------------------------------- 1 | library(topogram) 2 | library(shiny) 3 | 4 | ui <- fluidPage( 5 | tags$h2("Update number of iteration with proxy"), 6 | sliderInput( 7 | inputId = "n_iteration", 8 | label = "Number of iteration (more takes longer)", 9 | min = 1, 10 | max = 60, 11 | value = 10 12 | ), 13 | topogramOutput(outputId = "ID", height = "800px") 14 | ) 15 | 16 | server <- function(input, output, session) { 17 | 18 | # Initialize the topogram (non reactive) 19 | output$ID <- renderTopogram({ 20 | topogram( 21 | sfobj = world, 22 | value = "pop_est", 23 | label = "{name} : {value}" 24 | ) 25 | }) 26 | 27 | # Update with proxy 28 | observeEvent(input$n_iteration, { 29 | topogram_proxy_iteration("ID", input$n_iteration) 30 | }, ignoreInit = TRUE) 31 | 32 | } 33 | 34 | if (interactive()) 35 | shinyApp(ui, server) -------------------------------------------------------------------------------- /examples/topogram.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Interactive topogram" 3 | output: html_document 4 | --- 5 | 6 | ```{r setup, include=FALSE} 7 | knitr::opts_chunk$set(echo = TRUE, message = FALSE, warning = FALSE) 8 | library(topogram) 9 | ``` 10 | 11 | 12 | Create interactive topogram that you can update dynamically with a select menu. 13 | 14 | First add select menu: 15 | 16 | ```{r} 17 | topogram_select( 18 | topogramId = "ID", 19 | sfobj = world, 20 | values = list( 21 | "Population" = "pop_est", 22 | "GDP" = "gdp_md_est", 23 | "CO2 emissions (1990)" = "co2_emissions_1990", 24 | "CO2 emissions (2020)" = "co2_emissions_2020", 25 | "Share of electricity production from renewables" = "renewables_percent_electricity" 26 | ), 27 | label = "{name} : {value}" 28 | ) 29 | ``` 30 | 31 | Then create topogram: 32 | 33 | ```{r} 34 | topogram( 35 | sfobj = world, 36 | value = "pop_est", 37 | label = "{name} : {value}", 38 | elementId = "ID" 39 | ) 40 | ``` 41 | 42 | -------------------------------------------------------------------------------- /examples/proxy-labs.R: -------------------------------------------------------------------------------- 1 | library(topogram) 2 | library(shiny) 3 | 4 | ui <- fluidPage( 5 | tags$h2("Update topogram's labs with proxy"), 6 | fluidRow( 7 | column( 8 | width = 3, 9 | textInput("title", "Title"), 10 | textInput("subtitle", "Subtitle"), 11 | textInput("caption", "Caption") 12 | ), 13 | column( 14 | width = 9, 15 | topogramOutput(outputId = "ID", height = "800px") 16 | ) 17 | ) 18 | ) 19 | 20 | server <- function(input, output, session) { 21 | 22 | # Initialize the topogram (non reactive) 23 | output$ID <- renderTopogram({ 24 | topogram( 25 | sfobj = world, 26 | value = "pop_est", 27 | label = "{name} : {value}" 28 | ) 29 | }) 30 | 31 | # Update with proxy 32 | observe({ 33 | topogram_proxy("ID") %>% 34 | topogram_labs( 35 | title = input$title, 36 | subtitle = input$subtitle, 37 | caption = input$caption 38 | ) 39 | }) 40 | 41 | } 42 | 43 | if (interactive()) 44 | shinyApp(ui, server) -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: topogram 2 | Title: Create Interactive Continuous Cartogram 3 | Description: Cartogram 'htmlwidget' for visualizing geographical data by distorting 4 | a 'TopoJson' topology, using 'cartogram-chart' 'JavaScript' library . 5 | Version: 2.0.0 6 | Authors@R: c( 7 | person("Victor", "Perrier", role = c("aut", "cre"), email = "victor.perrier@dreamRs.fr"), 8 | person("Fanny", "Meyer", role = "aut"), 9 | person("Vasco", "Asturiano", role = "cph", comment = "cartogram-chart library") 10 | ) 11 | Depends: R (>= 2.10) 12 | Imports: 13 | geojsonio (>= 0.6.1), 14 | glue, 15 | htmlwidgets, 16 | htmltools, 17 | magrittr, 18 | rlang, 19 | scales, 20 | shiny 21 | Suggests: 22 | rmarkdown, 23 | knitr, 24 | rnaturalearth, 25 | sf, 26 | tinytest, 27 | covr 28 | Encoding: UTF-8 29 | LazyData: true 30 | RoxygenNote: 7.1.2 31 | Roxygen: list(markdown = TRUE) 32 | License: MIT + file LICENSE 33 | VignetteBuilder: knitr 34 | -------------------------------------------------------------------------------- /examples/proxy-update.R: -------------------------------------------------------------------------------- 1 | library(topogram) 2 | library(shiny) 3 | 4 | ui <- fluidPage( 5 | tags$h2("Update topogram with proxy"), 6 | radioButtons( 7 | inputId = "new_value", 8 | label = "Select a variable:", 9 | choices = names(world)[3:7], 10 | inline = TRUE 11 | ), 12 | topogramOutput(outputId = "ID", height = "800px") 13 | ) 14 | 15 | server <- function(input, output, session) { 16 | 17 | # Initialize the topogram (non reactive) 18 | output$ID <- renderTopogram({ 19 | topogram( 20 | sfobj = world, 21 | value = "pop_est", 22 | label = "{name} : {value}" 23 | ) %>% 24 | topogram_legend(title = "Population") 25 | }) 26 | 27 | # Update with proxy 28 | observeEvent(input$new_value, { 29 | topogram_proxy_update( 30 | "ID", world, 31 | value = input$new_value, 32 | label = "{name} : {value}" 33 | ) %>% 34 | topogram_legend(title = input$new_value) 35 | }, ignoreInit = TRUE) 36 | 37 | } 38 | 39 | if (interactive()) 40 | shinyApp(ui, server) 41 | -------------------------------------------------------------------------------- /.github/workflows/pkgdown.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/master/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | tags: ['*'] 7 | 8 | name: pkgdown 9 | 10 | jobs: 11 | pkgdown: 12 | runs-on: ubuntu-latest 13 | env: 14 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 15 | steps: 16 | - uses: actions/checkout@v2 17 | 18 | - uses: r-lib/actions/setup-pandoc@v1 19 | 20 | - uses: r-lib/actions/setup-r@v1 21 | with: 22 | use-public-rspm: true 23 | 24 | - uses: r-lib/actions/setup-r-dependencies@v1 25 | with: 26 | extra-packages: pkgdown 27 | needs: website 28 | 29 | - name: Deploy package 30 | run: | 31 | git config --local user.name "$GITHUB_ACTOR" 32 | git config --local user.email "$GITHUB_ACTOR@users.noreply.github.com" 33 | Rscript -e 'pkgdown::deploy_to_branch(new_process = FALSE)' 34 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | # MIT License 2 | 3 | Copyright (c) 2021 Victor Perrier 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /man/topogram_labs.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/topo-extras.R 3 | \name{topogram_labs} 4 | \alias{topogram_labs} 5 | \title{Labs for topogram widget} 6 | \usage{ 7 | topogram_labs(topo, title = NULL, subtitle = NULL, caption = NULL) 8 | } 9 | \arguments{ 10 | \item{topo}{A \code{\link[=topogram]{topogram()}} \code{htmlwidget} object.} 11 | 12 | \item{title}{Main title.} 13 | 14 | \item{subtitle}{Subtitle.} 15 | 16 | \item{caption}{Brief explanation of the source of the data.} 17 | } 18 | \value{ 19 | A \code{\link[=topogram]{topogram()}} / \code{\link[=topogram_proxy]{topogram_proxy()}} \code{htmlwidget} object. 20 | } 21 | \description{ 22 | Add title, subtitle and caption to a topogram. 23 | } 24 | \examples{ 25 | library(topogram) 26 | library(htmltools) 27 | 28 | topogram(world, "pop_est") \%>\% 29 | topogram_labs( 30 | title = "World population", 31 | subtitle = "Population estimate for 2017", 32 | caption = tagList( 33 | "Data source:", 34 | tags$a( 35 | href = "https://www.naturalearthdata.com/", 36 | "NaturalEarth" 37 | ) 38 | ) 39 | ) 40 | } 41 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | export("%>%") 4 | export(renderTopogram) 5 | export(topogram) 6 | export(topogramOutput) 7 | export(topogram_labs) 8 | export(topogram_legend) 9 | export(topogram_proxy) 10 | export(topogram_proxy_iteration) 11 | export(topogram_proxy_update) 12 | export(topogram_select) 13 | importFrom(geojsonio,geo2topo) 14 | importFrom(geojsonio,geojson_json) 15 | importFrom(glue,glue_data) 16 | importFrom(htmltools,css) 17 | importFrom(htmltools,doRenderTags) 18 | importFrom(htmltools,tagList) 19 | importFrom(htmltools,tags) 20 | importFrom(htmltools,validateCssUnit) 21 | importFrom(htmlwidgets,JS) 22 | importFrom(htmlwidgets,createWidget) 23 | importFrom(htmlwidgets,shinyRenderWidget) 24 | importFrom(htmlwidgets,shinyWidgetOutput) 25 | importFrom(htmlwidgets,sizingPolicy) 26 | importFrom(magrittr,"%>%") 27 | importFrom(rlang,"%||%") 28 | importFrom(rlang,is_character) 29 | importFrom(rlang,is_function) 30 | importFrom(rlang,is_list) 31 | importFrom(rlang,is_named) 32 | importFrom(rlang,is_null) 33 | importFrom(scales,col_numeric) 34 | importFrom(scales,colour_ramp) 35 | importFrom(scales,rescale) 36 | importFrom(shiny,getDefaultReactiveDomain) 37 | importFrom(stats,model.frame) 38 | importFrom(stats,setNames) 39 | importFrom(utils,modifyList) 40 | -------------------------------------------------------------------------------- /package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "topogram", 3 | "version": "1.0.0", 4 | "description": "> Cartogram htmlwidget for visualizing geographical data by distorting a TopoJson topology (using [cartogram-chart](https://github.com/vasturiano/cartogram-chart))", 5 | "main": "index.js", 6 | "directories": { 7 | "man": "man" 8 | }, 9 | "scripts": { 10 | "test": "echo \"Error: no test specified\" && exit 1", 11 | "none": "webpack --config webpack.dev.js --mode=none", 12 | "development": "webpack --config webpack.dev.js", 13 | "production": "webpack --config webpack.prod.js", 14 | "watch": "webpack --config webpack.dev.js -d --watch" 15 | }, 16 | "repository": { 17 | "type": "git", 18 | "url": "git+https://github.com/dreamRs/topogram.git" 19 | }, 20 | "keywords": [], 21 | "author": "", 22 | "license": "ISC", 23 | "bugs": { 24 | "url": "https://github.com/dreamRs/topogram/issues" 25 | }, 26 | "homepage": "https://github.com/dreamRs/topogram#readme", 27 | "devDependencies": { 28 | "cartogram-chart": "^1.2.3", 29 | "css-loader": "^6.5.1", 30 | "d3-geo": "^3.0.1", 31 | "d3-geo-projection": "^4.0.0", 32 | "slim-select": "^1.27.0", 33 | "style-loader": "^3.3.1", 34 | "topojson-client": "^3.1.0", 35 | "webpack": "^5.61.0", 36 | "webpack-cli": "^4.9.1", 37 | "webpack-merge": "^5.8.0" 38 | } 39 | } 40 | -------------------------------------------------------------------------------- /srcjs/modules/proxy.js: -------------------------------------------------------------------------------- 1 | import * as utils from "./utils"; 2 | 3 | export function getTopogram(id) { 4 | // Get the HTMLWidgets object 5 | var htmlWidgetsObj = HTMLWidgets.find("#" + id); 6 | 7 | // Use the getChart method we created to get the underlying billboard chart 8 | var widgetObj; 9 | 10 | if (typeof htmlWidgetsObj != "undefined") { 11 | widgetObj = htmlWidgetsObj.getTopogram(); 12 | } 13 | 14 | return widgetObj; 15 | } 16 | 17 | export function updateValues(obj) { 18 | var carto = getTopogram(obj.id); 19 | if (typeof carto == "undefined") return; 20 | carto 21 | .value(function(d) { 22 | var value = obj.data.values[d.properties.topogram_id]; 23 | if (value <= 0) { 24 | value = 0.001; 25 | } 26 | return value; 27 | }) 28 | .color(function(d) { 29 | return obj.data.colors[d.properties.topogram_id]; 30 | }) 31 | .tooltipContent(function(d) { 32 | return obj.data.labels[d.properties.topogram_id]; 33 | }) 34 | .iterations(obj.data.n_iteration); 35 | } 36 | 37 | export function updateIteration(obj) { 38 | var carto = getTopogram(obj.id); 39 | if (typeof carto !== "undefined") { 40 | carto 41 | .iterations(obj.data.n_iteration); 42 | } 43 | } 44 | 45 | export function updateLegend(obj) { 46 | utils.setLegend(obj.id, obj.data.content); 47 | } 48 | 49 | export function updateLabs(obj) { 50 | utils.setLabs(obj.id, true, obj.data); 51 | } 52 | -------------------------------------------------------------------------------- /data-raw/france.R: -------------------------------------------------------------------------------- 1 | 2 | # ------------------------------------------------------------------------ 3 | # 4 | # Title :France departments + employment data 5 | # Date : 2021-11-05 6 | # 7 | # ------------------------------------------------------------------------ 8 | 9 | 10 | # Packages ---------------------------------------------------------------- 11 | 12 | library(data.table) 13 | library(sf) 14 | library(rnaturalearth) 15 | library(rnaturalearthhires) 16 | library(janitor) 17 | library(readxl) 18 | 19 | 20 | 21 | # Polygons ---------------------------------------------------------------- 22 | 23 | france <- ne_states(country = "france", returnclass = "sf") 24 | france <- france[france$type_en %in% "Metropolitan department", ] 25 | france <- france[, c("name", "iso_3166_2")] 26 | 27 | 28 | 29 | # Data -------------------------------------------------------------------- 30 | 31 | # Structure de l'emploi total par grand secteur d'activité en 2019 32 | # Source: https://www.insee.fr/fr/statistiques/2012798 33 | 34 | emploi <- read_excel(path = "data-raw/TCRD_027.xlsx", skip = 3) 35 | names(emploi)[1] <- c("iso_3166_2") 36 | emploi[[2]] <- NULL 37 | emploi$iso_3166_2 <- paste0("FR-", emploi$iso_3166_2) 38 | 39 | france <- merge(x = france, y = emploi, by = "iso_3166_2", all.x = TRUE, all.y = FALSE) 40 | 41 | 42 | # Use --------------------------------------------------------------------- 43 | 44 | usethis::use_data(france, overwrite = TRUE) 45 | 46 | 47 | -------------------------------------------------------------------------------- /.github/workflows/R-CMD-check.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/master/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | pull_request: 7 | branches: [main, master] 8 | 9 | name: R-CMD-check 10 | 11 | jobs: 12 | R-CMD-check: 13 | runs-on: ${{ matrix.config.os }} 14 | 15 | name: ${{ matrix.config.os }} (${{ matrix.config.r }}) 16 | 17 | strategy: 18 | fail-fast: false 19 | matrix: 20 | config: 21 | - {os: macOS-latest, r: 'release'} 22 | - {os: windows-latest, r: 'release'} 23 | - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'} 24 | - {os: ubuntu-latest, r: 'release'} 25 | - {os: ubuntu-latest, r: 'oldrel-1'} 26 | 27 | env: 28 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 29 | R_KEEP_PKG_SOURCE: yes 30 | 31 | steps: 32 | - uses: actions/checkout@v2 33 | 34 | - uses: r-lib/actions/setup-pandoc@v1 35 | 36 | - uses: r-lib/actions/setup-r@v1 37 | with: 38 | r-version: ${{ matrix.config.r }} 39 | http-user-agent: ${{ matrix.config.http-user-agent }} 40 | use-public-rspm: true 41 | 42 | - uses: r-lib/actions/setup-r-dependencies@v1 43 | with: 44 | extra-packages: rcmdcheck 45 | 46 | - uses: r-lib/actions/check-r-package@v1 47 | -------------------------------------------------------------------------------- /man/topogRam-shiny.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/shiny.R 3 | \name{topogram-shiny} 4 | \alias{topogram-shiny} 5 | \alias{topogramOutput} 6 | \alias{renderTopogram} 7 | \alias{topogram_proxy} 8 | \title{Shiny bindings for topogram} 9 | \usage{ 10 | topogramOutput(outputId, width = "100\%", height = "400px") 11 | 12 | renderTopogram(expr, env = parent.frame(), quoted = FALSE) 13 | 14 | topogram_proxy(shinyId, session = shiny::getDefaultReactiveDomain()) 15 | } 16 | \arguments{ 17 | \item{outputId}{output variable to read from} 18 | 19 | \item{width, height}{Must be a valid CSS unit (like \code{'100\%'}, 20 | \code{'400px'}, \code{'auto'}) or a number, which will be coerced to a 21 | string and have \code{'px'} appended.} 22 | 23 | \item{expr}{An expression that generates a topogram} 24 | 25 | \item{env}{The environment in which to evaluate \code{expr}.} 26 | 27 | \item{quoted}{Is \code{expr} a quoted expression (with \code{quote()})? This 28 | is useful if you want to save an expression in a variable.} 29 | 30 | \item{shinyId}{single-element character vector indicating the output ID of the 31 | chart to modify (if invoked from a Shiny module, the namespace will be added 32 | automatically)} 33 | 34 | \item{session}{the Shiny session object to which the chart belongs; usually the 35 | default value will suffice} 36 | } 37 | \description{ 38 | Output and render functions for using topogram within Shiny 39 | applications and interactive Rmd documents. 40 | } 41 | -------------------------------------------------------------------------------- /srcjs/widgets/topogram_select.js: -------------------------------------------------------------------------------- 1 | import "widgets"; 2 | import SlimSelect from "slim-select"; 3 | import "../modules/slimselect.min.css"; 4 | import {getTopogram} from "../modules/proxy"; 5 | import * as utils from "../modules/utils"; 6 | 7 | HTMLWidgets.widget({ 8 | 9 | name: "topogram_select", 10 | 11 | type: "output", 12 | 13 | factory: function(el, width, height) { 14 | 15 | return { 16 | 17 | renderValue: function(x) { 18 | 19 | var select = new SlimSelect({ 20 | select: el, 21 | data: x.data, 22 | showSearch: false, 23 | onChange: function(info) { 24 | var carto = getTopogram(x.topogramId); 25 | if (typeof carto == "undefined") return; 26 | var topo = x.topo[info.value]; 27 | carto 28 | .value(function(d) { 29 | var value = topo.values[d.properties.topogram_id]; 30 | if (value <= 0) { 31 | value = 0.001; 32 | } 33 | return value; 34 | }) 35 | .color(function(d) { 36 | return topo.colors[d.properties.topogram_id]; 37 | }) 38 | .tooltipContent(function(d) { 39 | return topo.labels[d.properties.topogram_id]; 40 | }); 41 | utils.setLabs(x.topogramId, topo.hasOwnProperty("labs"), topo.labs); 42 | } 43 | }); 44 | 45 | }, 46 | 47 | resize: function(width, height) { 48 | 49 | } 50 | 51 | }; 52 | } 53 | }); 54 | -------------------------------------------------------------------------------- /inst/examples/nz-retail.R: -------------------------------------------------------------------------------- 1 | 2 | # ------------------------------------------------------------------------ 3 | # 4 | # Title : New Zealand Retail sales by region (2012) 5 | # By : Victor 6 | # Date : 2018-10-01 7 | # 8 | # ------------------------------------------------------------------------ 9 | 10 | 11 | 12 | # Packages ---------------------------------------------------------------- 13 | 14 | library(topogram) 15 | library(rnaturalearth) 16 | library(sf) 17 | library(rmapshaper) 18 | 19 | 20 | 21 | 22 | 23 | # Datas ------------------------------------------------------------------- 24 | 25 | # retail sales from : https://datafinder.stats.govt.nz/layer/95458-retail-trade-sales-per-capita-by-region-2012-2017/data/ 26 | # export shapefile with WGS 84 projection 27 | nz_retail <- read_sf("dev/statsnzretail-trade-sales-per-capita-by-region-2012-2017-SHP/retail-trade-sales-per-capita-by-region-2012-2017.shp") 28 | # nz_retail <- nz_retail[nz_retail$REGC2018_1 != "Area Outside Region", ] 29 | nz_retail <- ms_simplify(nz_retail) 30 | nz_retail 31 | 32 | 33 | 34 | # Cartogram --------------------------------------------------------------- 35 | 36 | topogram( 37 | shape = nz_retail, 38 | value = "Per_capita", 39 | tooltip_label = ~REGC2018_V, 40 | n_iteration = 20 41 | ) 42 | 43 | 44 | topogram( 45 | shape = nz_retail, 46 | value = c("Per_capita", "Per_capi_1", "Per_capi_2", "Per_capi_3", 47 | "Per_capi_4", "Per_capi_5", "Total_trad", "Total_tr_1", "Total_tr_2", 48 | "Total_tr_3"), 49 | tooltip_label = ~REGC2018_V, 50 | n_iteration = 20 51 | ) 52 | 53 | 54 | -------------------------------------------------------------------------------- /man/topogram_proxy_iteration.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/shiny.R 3 | \name{topogram_proxy_iteration} 4 | \alias{topogram_proxy_iteration} 5 | \title{Update number of iteration with proxy} 6 | \usage{ 7 | topogram_proxy_iteration(proxy, n_iteration) 8 | } 9 | \arguments{ 10 | \item{proxy}{A \code{topogram_proxy} \code{htmlwidget} object.} 11 | 12 | \item{n_iteration}{Number of iterations to run the algorithm for. Higher numbers distorts the areas closer to their associated value, 13 | at the cost of performance.} 14 | } 15 | \value{ 16 | A \code{topogram_proxy} \code{htmlwidget} object. 17 | } 18 | \description{ 19 | Use this in 'shiny' application to update an already generated \code{\link[=topogram]{topogram()}}. 20 | } 21 | \examples{ 22 | library(topogram) 23 | library(shiny) 24 | 25 | ui <- fluidPage( 26 | tags$h2("Update number of iteration with proxy"), 27 | sliderInput( 28 | inputId = "n_iteration", 29 | label = "Number of iteration (more takes longer)", 30 | min = 1, 31 | max = 60, 32 | value = 10 33 | ), 34 | topogramOutput(outputId = "ID", height = "800px") 35 | ) 36 | 37 | server <- function(input, output, session) { 38 | 39 | # Initialize the topogram (non reactive) 40 | output$ID <- renderTopogram({ 41 | topogram( 42 | sfobj = world, 43 | value = "pop_est", 44 | label = "{name} : {value}" 45 | ) 46 | }) 47 | 48 | # Update with proxy 49 | observeEvent(input$n_iteration, { 50 | topogram_proxy_iteration("ID", input$n_iteration) 51 | }, ignoreInit = TRUE) 52 | 53 | } 54 | 55 | if (interactive()) 56 | shinyApp(ui, server) 57 | } 58 | -------------------------------------------------------------------------------- /inst/examples/proxy-vector/app.R: -------------------------------------------------------------------------------- 1 | 2 | # ------------------------------------------------------------------------ 3 | # 4 | # Title : topogram - proxy : update value 5 | # By : Victor 6 | # Date : 2018-10-01 7 | # 8 | # ------------------------------------------------------------------------ 9 | 10 | 11 | 12 | 13 | # Packages ---------------------------------------------------------------- 14 | 15 | library( shiny ) 16 | library( rnaturalearth ) 17 | library( topogram ) 18 | library( dplyr ) 19 | 20 | 21 | 22 | 23 | # Data -------------------------------------------------------------------- 24 | 25 | # Paris population data 26 | data("paris") 27 | 28 | 29 | 30 | 31 | # App --------------------------------------------------------------------- 32 | 33 | 34 | library(shiny) 35 | 36 | ui <- fluidPage( 37 | fluidRow( 38 | column( 39 | width = 10, offset = 1, 40 | tags$h2("topogram : update value with proxy"), 41 | actionButton(inputId = "update", label = "Update random data"), 42 | topogramOutput(outputId = "carto", height = "600px") 43 | ) 44 | ) 45 | ) 46 | 47 | server <- function(input, output, session) { 48 | 49 | # Initialize 50 | output$carto <- renderTopogram({ 51 | topogram( 52 | shape = paris, 53 | value = "AGE_00", 54 | tooltip_label = ~paste0(LIB, " (", NAME, ")"), 55 | n_iteration = 1 56 | ) %>% 57 | add_legend(title = "FOOOO", label_format = ".2s") 58 | }) 59 | 60 | # Update 61 | observeEvent(input$update, { 62 | topogramProxy(shinyId = "carto") %>% 63 | proxy_update_value(new_value = floor(runif(20, min = 1000, max = 1000000))) 64 | }, ignoreInit = TRUE) 65 | 66 | } 67 | 68 | shinyApp(ui, server) 69 | -------------------------------------------------------------------------------- /examples/examples.R: -------------------------------------------------------------------------------- 1 | 2 | 3 | # Packages ---------------------------------------------------------------- 4 | 5 | library(topogram) 6 | library(sf) 7 | library(rnaturalearth) 8 | 9 | 10 | 11 | # Data -------------------------------------------------------------------- 12 | 13 | data("world", package = "topogram") 14 | 15 | 16 | # Default ----------------------------------------------------------------- 17 | 18 | topogram(world, value = "pop_est") 19 | topogram(world, value = "pop_est", n_iteration = 50) 20 | 21 | 22 | 23 | # Tooltip ----------------------------------------------------------------- 24 | 25 | topogram(world, value = "pop_est", label = "{name}: {format(pop_est, big.mark = ',')}") 26 | 27 | library(htmltools) 28 | topogram( 29 | sfobj = world, 30 | value = "pop_est", 31 | label = tagList(tags$b("{name}:"), tags$br(), "{format(pop_est, big.mark = ',')}") 32 | ) 33 | 34 | 35 | 36 | # Colors ------------------------------------------------------------------ 37 | 38 | topogram(shape = world, value = "pop_est", palette = "Blues") 39 | 40 | library(scales) 41 | topogram( 42 | sfobj = world, 43 | value = "pop_est", 44 | palette = col_quantile("Blues", domain = NULL) 45 | ) 46 | topogram( 47 | sfobj = world, 48 | value = "pop_est", 49 | palette = col_bin("Blues", domain = NULL) 50 | ) 51 | 52 | 53 | 54 | # Projections ------------------------------------------------------------- 55 | 56 | topogram(world, value = "pop_est", n_iteration = 1) 57 | topogram(world, value = "pop_est", n_iteration = 1, projection = "geoEqualEarth") 58 | topogram(world, value = "pop_est", n_iteration = 1, projection = "geoEckert1") 59 | topogram(world, value = "pop_est", n_iteration = 1, projection = "geoKavrayskiy7") 60 | 61 | -------------------------------------------------------------------------------- /examples/selectmenu.R: -------------------------------------------------------------------------------- 1 | library(topogram) 2 | library(htmltools) 3 | 4 | # normally, you would use the following in RMarkdown 5 | 6 | browsable(tagList( 7 | # Select menu 8 | topogram_select( 9 | topogramId = "ID", 10 | sfobj = world, 11 | values = list( 12 | "Population" = "pop_est", 13 | "GDP" = "gdp_md_est", 14 | "CO2 emissions (1990)" = "co2_emissions_1990", 15 | "CO2 emissions (2020)" = "co2_emissions_2020", 16 | "Share of electricity production from renewables" = "renewables_percent_electricity" 17 | ), 18 | label = "{name} : {value}" 19 | ), 20 | 21 | # Topogram 22 | topogram( 23 | sfobj = world, 24 | value = "pop_est", 25 | label = "{name} : {value}", 26 | elementId = "ID" 27 | ) 28 | ), value = interactive()) 29 | 30 | 31 | # specific options according to variables 32 | browsable(tagList( 33 | # Select menu 34 | topogram_select( 35 | topogramId = "ID", 36 | sfobj = world, 37 | values = list( 38 | list( 39 | text = "Population", 40 | value = "pop_est", 41 | palette = "Greens", 42 | label = "{name} : {value} inhabitants" 43 | ), 44 | list( 45 | text = "GDP", 46 | value = "gdp_md_est", 47 | palette = "Blues", 48 | label = "{name} : ${value}", 49 | labs = list(title = "GDP", subtitle = "estimate, in 2017") 50 | ) 51 | ), 52 | label = "{name} : {value}" 53 | ), 54 | 55 | # Topogram 56 | topogram( 57 | sfobj = world, 58 | value = "pop_est", 59 | elementId = "ID", 60 | # you have to specify parameters for initializing topogram 61 | palette = "Greens", 62 | label = "{name} : {value} inhabitants" 63 | ) 64 | ), value = interactive()) 65 | -------------------------------------------------------------------------------- /man/topogram_legend.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/topo-extras.R 3 | \name{topogram_legend} 4 | \alias{topogram_legend} 5 | \title{Legend for topogram widget} 6 | \usage{ 7 | topogram_legend( 8 | topo, 9 | colors = NULL, 10 | labels = NULL, 11 | formatter = NULL, 12 | title = NULL, 13 | direction = c("h", "v"), 14 | height = "250px", 15 | width = "250px" 16 | ) 17 | } 18 | \arguments{ 19 | \item{topo}{A \code{\link[=topogram]{topogram()}} / \code{\link[=topogram_proxy]{topogram_proxy()}} \code{htmlwidget} object.} 20 | 21 | \item{colors}{Vector of colors used in legend, default is to use colors used in \code{\link[=topogram]{topogram()}}.} 22 | 23 | \item{labels}{Labels to display for values, default is to use range of values used in \code{\link[=topogram]{topogram()}}.} 24 | 25 | \item{formatter}{Function to format labels, like \code{\link[scales:label_number]{scales::label_number()}}.} 26 | 27 | \item{title}{Title for the legend.} 28 | 29 | \item{direction}{Direction: horizontal or vertical.} 30 | 31 | \item{height, width}{Height, width for legend. For gradient legend it 32 | represent the size of the dradient according to direction.} 33 | } 34 | \value{ 35 | A \code{\link[=topogram]{topogram()}} / \code{\link[=topogram_proxy]{topogram_proxy()}} \code{htmlwidget} object. 36 | } 37 | \description{ 38 | Add a gradient legend in a \code{\link[=topogram]{topogram()}} widget. 39 | } 40 | \examples{ 41 | library(topogram) 42 | 43 | topogram(world, value = "pop_est") \%>\% 44 | topogram_legend(title = "Population") 45 | 46 | topogram(world, value = "pop_est", palette = "Blues") \%>\% 47 | topogram_legend( 48 | title = NULL, 49 | formatter = scales::label_comma(), 50 | direction = "v" 51 | ) 52 | } 53 | -------------------------------------------------------------------------------- /srcjs/modules/utils.js: -------------------------------------------------------------------------------- 1 | export function removeElement(elementId) { 2 | var element = document.getElementById(elementId); 3 | if (element !== null) 4 | element.parentNode.removeChild(element); 5 | } 6 | 7 | export function setLabs(elementId, enabled, options) { 8 | if (!enabled) { 9 | document.getElementById(elementId + "-title").style.display = "none"; 10 | document.getElementById(elementId + "-subtitle").style.display = "none"; 11 | document.getElementById(elementId + "-caption").style.display = "none"; 12 | } else { 13 | if (typeof options.title === "string" || options.title instanceof String) { 14 | document.getElementById(elementId + "-title").innerHTML = options.title; 15 | document.getElementById(elementId + "-title").style.display = "block"; 16 | } else { 17 | document.getElementById(elementId + "-title").style.display = "none"; 18 | } 19 | if (typeof options.subtitle === "string" || options.subtitle instanceof String) { 20 | document.getElementById(elementId + "-subtitle").innerHTML = 21 | options.subtitle; 22 | document.getElementById(elementId + "-subtitle").style.display = "block"; 23 | } else { 24 | document.getElementById(elementId + "-subtitle").style.display = "none"; 25 | } 26 | if (typeof options.caption === "string" || options.caption instanceof String) { 27 | document.getElementById(elementId + "-caption").innerHTML = 28 | options.caption; 29 | document.getElementById(elementId + "-caption").style.display = "block"; 30 | } else { 31 | document.getElementById(elementId + "-caption").style.display = "none"; 32 | } 33 | } 34 | } 35 | 36 | export function setLegend(elementId, content) { 37 | document.getElementById(elementId + "-legend").innerHTML = content; 38 | } 39 | -------------------------------------------------------------------------------- /inst/tinytest/test_topogram.R: -------------------------------------------------------------------------------- 1 | library(topogram) 2 | library(tinytest) 3 | 4 | # topogram 5 | topo <- topogram(world, "pop_est") 6 | expect_inherits(topo, "topogram") 7 | 8 | topo_html <- topogram:::topogram_html(id = "ID", NULL, NULL) 9 | expect_inherits(topo_html, "shiny.tag") 10 | expect_true(grepl(pattern = "ID-topogram", x = as.character(topo_html))) 11 | 12 | 13 | # proxy 14 | session <- shiny::MockShinySession$new() 15 | proxy <- topogram_proxy("ID", session = session) 16 | expect_inherits(proxy, "topogram_Proxy") 17 | expect_inherits(topogram_proxy_iteration(proxy, n_iteration = 50), "topogram_Proxy") 18 | expect_inherits(topogram_proxy_update(proxy, sfobj = world, value = "pop_est"), "topogram_Proxy") 19 | 20 | # title 21 | topo_title <- topogram_labs(topo, title = "This is a test") 22 | expect_inherits(topo_title, "topogram") 23 | expect_identical(as.character(topo_title$x$labsOpts$title), "This is a test") 24 | 25 | proxy_title <- topogram_labs(proxy, title = "This is a test") 26 | expect_inherits(proxy_title, "topogram_Proxy") 27 | 28 | 29 | # legend 30 | topo_legend <- topogram_legend(topo, title = "This is a test") 31 | expect_inherits(topo_legend, "topogram") 32 | 33 | proxy_legend <- topogram_legend(proxy, colors = c("#ffffff", "#000000"), title = "This is a test") 34 | expect_inherits(proxy_legend, "topogram_Proxy") 35 | 36 | 37 | # topogram_select 38 | sel <- topogram_select("ID", world, "pop_est") 39 | expect_inherits(sel, "topogram_select") 40 | 41 | sel_html <- topogram:::topogram_select_html(id = "ID", NULL, NULL) 42 | expect_inherits(sel_html, "shiny.tag") 43 | expect_identical(sel_html$name, "select") 44 | 45 | 46 | # bad use 47 | expect_error(topogram(iris, "Sepal.Width")) 48 | expect_error(topogram(world, "bad_variable")) 49 | worldna <- world 50 | worldna$pop_est[1] <- NA 51 | expect_error(topogram(worldna, "pop_est")) 52 | -------------------------------------------------------------------------------- /inst/examples/proxy-vector2/app.R: -------------------------------------------------------------------------------- 1 | 2 | # ------------------------------------------------------------------------ 3 | # 4 | # Title : topogram - proxy : update value 5 | # By : Victor 6 | # Date : 2018-10-01 7 | # 8 | # ------------------------------------------------------------------------ 9 | 10 | 11 | 12 | 13 | # Packages ---------------------------------------------------------------- 14 | 15 | library( shiny ) 16 | library( rnaturalearth ) 17 | library( topogram ) 18 | library( dplyr ) 19 | 20 | 21 | 22 | 23 | # Data -------------------------------------------------------------------- 24 | 25 | # map data 26 | fr_dept <- ne_states(country = "france", returnclass = "sf") 27 | fr_dept <- fr_dept[fr_dept$type_en %in% "Metropolitan department", ] 28 | 29 | 30 | fr_dept$foo <- floor(runif(96, min = 1000, max = 1000000)) 31 | 32 | 33 | 34 | # App --------------------------------------------------------------------- 35 | 36 | 37 | library(shiny) 38 | 39 | ui <- fluidPage( 40 | fluidRow( 41 | column( 42 | width = 10, offset = 1, 43 | tags$h2("topogram : update value with proxy"), 44 | actionButton(inputId = "update", label = "Update random data"), 45 | topogramOutput(outputId = "carto", height = "600px") 46 | ) 47 | ) 48 | ) 49 | 50 | server <- function(input, output, session) { 51 | 52 | # Initialize 53 | output$carto <- renderTopogram({ 54 | topogram( 55 | shape = fr_dept, 56 | value = "foo", 57 | tooltip_label = ~name, 58 | n_iteration = 1 59 | ) 60 | }) 61 | 62 | # Update 63 | observeEvent(input$update, { 64 | topogramProxy(shinyId = "carto") %>% 65 | proxy_update_iteration(n_iteration = 10) %>% 66 | proxy_update_value(new_value = floor(runif(96, min = 1000, max = 1000000))) 67 | }, ignoreInit = TRUE) 68 | 69 | } 70 | 71 | shinyApp(ui, server) 72 | -------------------------------------------------------------------------------- /inst/examples/france-pop.R: -------------------------------------------------------------------------------- 1 | 2 | # ------------------------------------------------------------------------ 3 | # 4 | # Title : Cartogram for France 5 | # By : Victor 6 | # Date : 2018-10-01 7 | # 8 | # ------------------------------------------------------------------------ 9 | 10 | 11 | 12 | # Packages ---------------------------------------------------------------- 13 | 14 | library( rnaturalearth ) 15 | library( topogram ) 16 | library( dplyr ) 17 | 18 | 19 | 20 | # Datas ------------------------------------------------------------------- 21 | 22 | # population data 23 | data("pop_france") 24 | glimpse(pop_france) 25 | 26 | 27 | # map data 28 | fr_dept <- ne_states(country = "france", returnclass = "sf") 29 | fr_dept <- fr_dept[fr_dept$type_en %in% "Metropolitan department", ] 30 | 31 | 32 | 33 | # join data 34 | fr_data <- left_join( 35 | x = fr_dept %>% select(name, iso_3166_2) %>% mutate(code_dep = gsub("FR-", "", iso_3166_2)), 36 | y = pop_france, 37 | by = c("code_dep" = "departements_code") 38 | ) 39 | fr_data 40 | 41 | 42 | 43 | 44 | # Cartogram --------------------------------------------------------------- 45 | 46 | # one var 47 | topogram( 48 | shape = fr_data, 49 | value = "femmes_20_a_39_ans", 50 | tooltip_label = ~name, 51 | n_iteration = 10, 52 | format_value = ",", 53 | d3_locale = "fr-FR" 54 | ) %>% add_legend( 55 | title = "Femme 20-39 ans", 56 | title_width = 200, 57 | orientation = "vertical", 58 | label_format = ",.2r" #.2s 59 | ) 60 | 61 | 62 | # all vars 63 | topogram( 64 | shape = fr_data, 65 | value = names(fr_data)[5:22], 66 | tooltip_label = ~name, 67 | n_iteration = 10, 68 | select_label = NULL, 69 | format_value = ",", 70 | d3_locale = "fr-FR" 71 | ) %>% add_legend( 72 | title = "", 73 | title_width = 200, 74 | orientation = "vertical", 75 | label_format = ",.2r" #.2s 76 | ) 77 | 78 | -------------------------------------------------------------------------------- /man/topogRam.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/topogram.R 3 | \name{topogram} 4 | \alias{topogram} 5 | \title{Cartogram htmlwidget for visualizing geographical data by distorting a TopoJson topology} 6 | \usage{ 7 | topogram( 8 | sfobj, 9 | value, 10 | label = "{value}", 11 | palette = "viridis", 12 | rescale_to = c(1, 1000), 13 | n_iteration = 10, 14 | projection = "geoMercator", 15 | layerId = NULL, 16 | width = NULL, 17 | height = NULL, 18 | elementId = NULL 19 | ) 20 | } 21 | \arguments{ 22 | \item{sfobj}{An \code{sf} object. For the time being, shape must be projected in Mercator (CRS 4326).} 23 | 24 | \item{value}{Variable name to use to distort topology.} 25 | 26 | \item{label}{\code{glue} string to be used in tooltip, you can use HTML tags in it.} 27 | 28 | \item{palette}{Name of a color palette, such as \code{"viridis"}, \code{"Blues"}, ... 29 | Or a function to map data values to colors, see \code{\link[scales:col_numeric]{scales::col_numeric()}}.} 30 | 31 | \item{rescale_to}{Rescale value to distort topology to a specified range, use \code{NULL} to use values as is.} 32 | 33 | \item{n_iteration}{Number of iterations to run the algorithm for. Higher numbers distorts the areas closer to their associated value, 34 | at the cost of performance.} 35 | 36 | \item{projection}{Name of a projection, see available ones here: https://github.com/d3/d3-geo-projection.} 37 | 38 | \item{layerId}{A formula, the layer id to specify value returned by \verb{input$_click} in 'shiny' application.} 39 | 40 | \item{width}{A numeric input in pixels.} 41 | 42 | \item{height}{A numeric input in pixels.} 43 | 44 | \item{elementId}{Use an explicit element ID for the widget.} 45 | } 46 | \value{ 47 | A \code{\link[=topogram]{topogram()}} \code{htmlwidget} object. 48 | } 49 | \description{ 50 | Continuous area cartograms with \code{d3.js} and \href{https://github.com/vasturiano/cartogram-chart}{\code{cartogram-chart}}. 51 | } 52 | -------------------------------------------------------------------------------- /inst/examples/shiny-click/app.R: -------------------------------------------------------------------------------- 1 | 2 | # ------------------------------------------------------------------------ 3 | # 4 | # Title : topogram - proxy : update value 5 | # By : Victor 6 | # Date : 2018-10-01 7 | # 8 | # ------------------------------------------------------------------------ 9 | 10 | 11 | 12 | 13 | # Packages ---------------------------------------------------------------- 14 | 15 | library( shiny ) 16 | library( rnaturalearth ) 17 | library( topogram ) 18 | library( dplyr ) 19 | 20 | 21 | 22 | 23 | # Data -------------------------------------------------------------------- 24 | 25 | # population data 26 | data("pop_france") 27 | 28 | 29 | # map data 30 | fr_dept <- ne_states(country = "france", returnclass = "sf") 31 | fr_dept <- fr_dept[fr_dept$type_en %in% "Metropolitan department", ] 32 | 33 | 34 | 35 | # join data 36 | fr_data <- left_join( 37 | x = fr_dept %>% select(name, iso_3166_2) %>% mutate(code_dep = gsub("FR-", "", iso_3166_2)), 38 | y = pop_france, 39 | by = c("code_dep" = "departements_code") 40 | ) 41 | 42 | 43 | 44 | 45 | 46 | # App --------------------------------------------------------------------- 47 | 48 | 49 | library(shiny) 50 | 51 | ui <- fluidPage( 52 | fluidRow( 53 | column( 54 | width = 10, offset = 1, 55 | tags$h2("topogram : retrieve data by clicking"), 56 | topogramOutput(outputId = "carto", height = "600px"), 57 | verbatimTextOutput(outputId = "click") 58 | ) 59 | ) 60 | ) 61 | 62 | server <- function(input, output, session) { 63 | 64 | # Initialize 65 | output$carto <- renderTopogram({ 66 | topogram( 67 | shape = fr_data, 68 | value = "femmes_0_a_19_ans", 69 | tooltip_label = ~name, 70 | n_iteration = 10 71 | # , layerId = ~name # use this to only return "name" otherwise all are returned 72 | ) 73 | }) 74 | 75 | # retrieve value clicked 76 | output$click <- renderPrint({ 77 | input$carto_click 78 | }) 79 | 80 | } 81 | 82 | shinyApp(ui, server) 83 | -------------------------------------------------------------------------------- /inst/examples/projections.R: -------------------------------------------------------------------------------- 1 | # ------------------------------------------------------------------------ 2 | # 3 | # Title : Projection 4 | # By : Victor 5 | # Date : 2018-10-01 6 | # 7 | # ------------------------------------------------------------------------ 8 | 9 | 10 | 11 | # Packages ---------------------------------------------------------------- 12 | 13 | library( topogram ) 14 | library( rnaturalearth ) 15 | library( dplyr ) 16 | library( sf ) 17 | library( rmapshaper ) 18 | 19 | 20 | 21 | 22 | # Data -------------------------------------------------------------------- 23 | 24 | wrld <- st_as_sf(countries110) 25 | # Remove missing values 26 | wrld <- wrld[!is.na(wrld$pop_est), c("name", "pop_est", "gdp_md_est")] 27 | # Antarctica is not a whole polygon 28 | wrld <- wrld[wrld$name != "Antarctica", ] 29 | plot(st_geometry(wrld)) 30 | wrld 31 | 32 | 33 | 34 | # Mercator ---------------------------------------------------------------- 35 | 36 | topogram( 37 | shape = wrld, 38 | value = "pop_est", 39 | n_iteration = 1 # no distortion 40 | ) 41 | 42 | 43 | 44 | # Albers ------------------------------------------------------------------ 45 | 46 | topogram( 47 | shape = wrld, 48 | value = "pop_est", 49 | n_iteration = 1 # no distortion 50 | , projection = "Albers" 51 | ) 52 | 53 | 54 | 55 | # Natural Earth ----------------------------------------------------------- 56 | 57 | topogram( 58 | shape = wrld, 59 | value = "pop_est", 60 | n_iteration = 1 # no distortion 61 | , projection = "NaturalEarth1" 62 | ) 63 | 64 | 65 | # ConicEqualArea ---------------------------------------------------------- 66 | 67 | topogram( 68 | shape = wrld, 69 | value = "pop_est", 70 | n_iteration = 1 # no distortion 71 | , projection = "ConicEqualArea" 72 | ) 73 | 74 | 75 | 76 | # Eckert IV --------------------------------------------------------------- 77 | 78 | topogram( 79 | shape = wrld, 80 | value = "pop_est", 81 | n_iteration = 1 # no distortion 82 | , projection = "Eckert4" 83 | ) 84 | -------------------------------------------------------------------------------- /webpack.common.js: -------------------------------------------------------------------------------- 1 | const path = require('path'); 2 | const fs = require('fs'); 3 | 4 | // defaults 5 | var outputPath = [], 6 | entryPoints = [], 7 | externals = [], 8 | misc = [], 9 | loaders = []; 10 | 11 | var outputPathFile = './srcjs/config/output_path.json', 12 | entryPointsFile = './srcjs/config/entry_points.json', 13 | externalsFile = './srcjs/config/externals.json', 14 | miscFile = './srcjs/config/misc.json', 15 | loadersFile = './srcjs/config/loaders.json'; 16 | 17 | // Read config files 18 | if(fs.existsSync(outputPathFile)){ 19 | outputPath = fs.readFileSync(outputPathFile, 'utf8'); 20 | } 21 | 22 | if(fs.existsSync(entryPointsFile)){ 23 | entryPoints = fs.readFileSync(entryPointsFile, 'utf8'); 24 | } 25 | 26 | if(fs.existsSync(externalsFile)){ 27 | externals = fs.readFileSync(externalsFile, 'utf8'); 28 | } 29 | 30 | if(fs.existsSync(miscFile)){ 31 | misc = fs.readFileSync(miscFile, 'utf8'); 32 | } 33 | 34 | if(fs.existsSync(loadersFile)){ 35 | loaders = fs.readFileSync(loadersFile, 'utf8'); 36 | } 37 | 38 | if(fs.existsSync(loadersFile)){ 39 | loaders = fs.readFileSync(loadersFile, 'utf8'); 40 | } 41 | 42 | // parse 43 | loaders = JSON.parse(loaders); 44 | misc = JSON.parse(misc); 45 | externals = JSON.parse(externals); 46 | entryPoints = JSON.parse(entryPoints); 47 | 48 | // parse regex 49 | loaders.forEach((loader) => { 50 | loader.test = RegExp(loader.test); 51 | return(loader); 52 | }) 53 | 54 | // placeholder for plugins 55 | var plugins = [ 56 | ]; 57 | 58 | // define options 59 | var options = { 60 | entry: entryPoints, 61 | output: { 62 | filename: '[name].js', 63 | path: path.resolve(__dirname, JSON.parse(outputPath)), 64 | }, 65 | externals: externals, 66 | module: { 67 | rules: loaders 68 | }, 69 | resolve: { 70 | extensions: ['.tsx', '.ts', '.js'], 71 | }, 72 | plugins: plugins 73 | }; 74 | 75 | // add misc 76 | if(misc.resolve) 77 | options.resolve = misc.resolve; 78 | 79 | // export 80 | module.exports = options; 81 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # topogram 2 | 3 | > Cartogram htmlwidget for visualizing geographical data by distorting a TopoJson topology, using [cartogram-chart](https://github.com/vasturiano/cartogram-chart) 4 | 5 | 6 | [![Project Status: Active – The project has reached a stable, usable state and is being actively developed.](http://www.repostatus.org/badges/latest/active.svg)](http://www.repostatus.org/) 7 | [![R-CMD-check](https://github.com/dreamRs/topogram/workflows/R-CMD-check/badge.svg)](https://github.com/dreamRs/topogram/actions) 8 | [![Codecov test coverage](https://codecov.io/gh/dreamRs/topogram/branch/master/graph/badge.svg)](https://app.codecov.io/gh/dreamRs/topogram?branch=master) 9 | 10 | 11 | 12 | ### Installation 13 | 14 | Install from [GitHub](https://github.com/dreamRs/topogram): 15 | 16 | ```r 17 | remotes::install_github("dreamRs/topogram") 18 | ``` 19 | 20 | 21 | ### Overview 22 | 23 | ![](man/figures/topogram.png) 24 | 25 | Created with: 26 | 27 | ```r 28 | library(topogram) 29 | world %>% 30 | topogram( 31 | value = "pop_est", 32 | label = "{name}: {format(pop_est, big.mark = ',')}", 33 | palette = scales::col_bin("viridis", bins = 20, domain = NULL) 34 | ) %>% 35 | topogram_legend( 36 | title = "Population", 37 | formatter = scales::label_comma() 38 | ) %>% 39 | topogram_labs( 40 | title = "World population", 41 | subtitle = "Population estimate for 2017", 42 | caption = "Data source: NaturalEarth" 43 | ) 44 | ``` 45 | 46 | More examples in the [{pkgdown} website](https://dreamrs.github.io/topogram/) 47 | 48 | 49 | ## Development 50 | 51 | This package use [{packer}](https://github.com/JohnCoene/packer) to manage JavaScript assets, see packer's [documentation](https://packer.john-coene.com/#/) for more. 52 | 53 | Install nodes modules with: 54 | 55 | ```r 56 | packer::npm_install() 57 | ``` 58 | 59 | Modify `srcjs/widgets/topogram.js`, then run: 60 | 61 | ```r 62 | packer::bundle() 63 | ``` 64 | 65 | Re-install R package and try `topogram()` functions. 66 | -------------------------------------------------------------------------------- /inst/examples/features.R: -------------------------------------------------------------------------------- 1 | 2 | 3 | library(shiny) 4 | 5 | ui <- fluidPage( 6 | fluidRow( 7 | column( 8 | width = 6, 9 | topogramOutput(outputId = "carto1") 10 | ), 11 | column( 12 | width = 6, 13 | topogramOutput(outputId = "carto2") 14 | ) 15 | ), 16 | fluidRow( 17 | column( 18 | width = 6, 19 | topogramOutput(outputId = "carto3") 20 | ), 21 | column( 22 | width = 6, 23 | topogramOutput(outputId = "carto4") 24 | ) 25 | ) 26 | ) 27 | 28 | server <- function(input, output, session) { 29 | 30 | output$carto1 <- renderTopogRam({ 31 | topogram( 32 | shape = fr_data, 33 | value = "femmes_20_a_39_ans", 34 | tooltip_label = ~name, 35 | n_iteration = 3, 36 | format_value = ",", 37 | d3_locale = "fr-FR" 38 | ) %>% add_labs(title = "Create interactive cartogram") 39 | }) 40 | 41 | output$carto2 <- renderTopogRam({ 42 | topogram( 43 | shape = fr_data, 44 | value = "femmes_20_a_39_ans", 45 | tooltip_label = ~name, 46 | n_iteration = 3, 47 | format_value = ",", 48 | d3_locale = "fr-FR" 49 | ) %>% add_labs(title = "Add legend") %>% 50 | add_legend(title = "Femmes entre 20 et 39 ans", title_width = 200, orientation = "vertical", label_format = ",.2r") 51 | }) 52 | 53 | output$carto3 <- renderTopogRam({ 54 | topogram( 55 | shape = fr_data, 56 | value = "femmes_20_a_39_ans", 57 | tooltip_label = ~name, 58 | n_iteration = 120, 59 | format_value = ",", 60 | d3_locale = "fr-FR" 61 | ) %>% add_labs(title = "Specify number of iteration to distort topology") 62 | }) 63 | 64 | output$carto4 <- renderTopogRam({ 65 | topogram( 66 | shape = fr_data, 67 | value = "femmes_20_a_39_ans", 68 | tooltip_label = ~name, 69 | n_iteration = 1, 70 | format_value = ",", 71 | d3_locale = "fr-FR", projection = "Armadillo", palette = "YlOrBr" 72 | ) %>% add_labs(title = "Differents color scales & projection implemented") 73 | }) 74 | 75 | } 76 | 77 | shinyApp(ui, server) 78 | -------------------------------------------------------------------------------- /inst/examples/proxy-iteration/app.R: -------------------------------------------------------------------------------- 1 | 2 | # ------------------------------------------------------------------------ 3 | # 4 | # Title : topogram - proxy : update value 5 | # By : Victor 6 | # Date : 2018-10-01 7 | # 8 | # ------------------------------------------------------------------------ 9 | 10 | 11 | 12 | 13 | # Packages ---------------------------------------------------------------- 14 | 15 | library( shiny ) 16 | library( rnaturalearth ) 17 | library( topogram ) 18 | library( dplyr ) 19 | 20 | 21 | 22 | 23 | # Data -------------------------------------------------------------------- 24 | 25 | # population data 26 | data("pop_france") 27 | 28 | 29 | # map data 30 | fr_dept <- ne_states(country = "france", returnclass = "sf") 31 | fr_dept <- fr_dept[fr_dept$type_en %in% "Metropolitan department", ] 32 | 33 | 34 | 35 | # join data 36 | fr_data <- left_join( 37 | x = fr_dept %>% select(name, iso_3166_2) %>% mutate(code_dep = gsub("FR-", "", iso_3166_2)), 38 | y = pop_france, 39 | by = c("code_dep" = "departements_code") 40 | ) 41 | 42 | 43 | 44 | 45 | 46 | # App --------------------------------------------------------------------- 47 | 48 | 49 | library(shiny) 50 | 51 | ui <- fluidPage( 52 | fluidRow( 53 | column( 54 | width = 10, offset = 1, 55 | tags$h2("topogram : update number of iterations with proxy"), 56 | sliderInput( 57 | inputId = "n_iteration", label = "Number of iteration (more takes longer)", 58 | min = 1, max = 120, value = 20 59 | ), 60 | topogramOutput(outputId = "carto", height = "600px") 61 | ) 62 | ) 63 | ) 64 | 65 | server <- function(input, output, session) { 66 | 67 | # Initialize 68 | output$carto <- renderTopogram({ 69 | topogram( 70 | shape = fr_data, 71 | value = "femmes_0_a_19_ans", 72 | tooltip_label = ~name, 73 | n_iteration = 10 74 | ) 75 | }) 76 | 77 | # Update 78 | observeEvent(input$n_iteration, { 79 | topogramProxy(shinyId = "carto") %>% 80 | proxy_update_iteration(n_iteration = input$n_iteration) 81 | }, ignoreInit = TRUE) 82 | 83 | } 84 | 85 | shinyApp(ui, server) 86 | -------------------------------------------------------------------------------- /inst/examples/proxy-value2/app.R: -------------------------------------------------------------------------------- 1 | 2 | # ------------------------------------------------------------------------ 3 | # 4 | # Title : topogram - proxy : update value 5 | # By : Victor 6 | # Date : 2018-10-01 7 | # 8 | # ------------------------------------------------------------------------ 9 | 10 | 11 | 12 | 13 | # Packages ---------------------------------------------------------------- 14 | 15 | library( shiny ) 16 | library( rnaturalearth ) 17 | library( topogram ) 18 | library( dplyr ) 19 | 20 | 21 | 22 | 23 | # Data -------------------------------------------------------------------- 24 | 25 | # map data 26 | fr_dept <- ne_states(country = "france", returnclass = "sf") 27 | fr_dept <- fr_dept[fr_dept$type_en %in% "Metropolitan department", ] 28 | 29 | fr_dept$foo1 <- floor(runif(96, min = 1000, max = 1000000)) 30 | fr_dept$foo2 <- floor(runif(96, min = 1000, max = 1000000)) 31 | fr_dept$foo3 <- floor(runif(96, min = 1000, max = 1000000)) 32 | fr_dept$foo4 <- floor(runif(96, min = 1000, max = 1000000)) 33 | fr_dept$foo5 <- floor(runif(96, min = 1000, max = 1000000)) 34 | fr_dept$foo6 <- floor(runif(96, min = 1000, max = 1000000)) 35 | 36 | 37 | 38 | 39 | 40 | # App --------------------------------------------------------------------- 41 | 42 | 43 | library(shiny) 44 | 45 | ui <- fluidPage( 46 | fluidRow( 47 | column( 48 | width = 10, offset = 1, 49 | tags$h2("topogram : update value with proxy"), 50 | radioButtons( 51 | inputId = "new_value", 52 | label = "Variable to use:", 53 | choices = paste0("foo", 1:6), 54 | inline = TRUE 55 | ), 56 | topogramOutput(outputId = "carto", height = "600px") 57 | ) 58 | ) 59 | ) 60 | 61 | server <- function(input, output, session) { 62 | 63 | # Initialize 64 | output$carto <- renderTopogram({ 65 | topogram( 66 | shape = fr_dept, 67 | value = "foo1", 68 | tooltip_label = ~name, 69 | n_iteration = 10 70 | ) 71 | }) 72 | 73 | # Update 74 | observeEvent(input$new_value, { 75 | topogramProxy(shinyId = "carto") %>% 76 | proxy_update_value(new_value = input$new_value) 77 | }, ignoreInit = TRUE) 78 | 79 | } 80 | 81 | shinyApp(ui, server) 82 | -------------------------------------------------------------------------------- /inst/tinytest/test_utils.R: -------------------------------------------------------------------------------- 1 | library(topogram) 2 | library(tinytest) 3 | 4 | expect_inherits(topogram:::linear_gradient(letters, direction = "h"), "character") 5 | expect_inherits(topogram:::linear_gradient(letters, direction = "v"), "character") 6 | 7 | col1 <- topogram:::getColors("Blues", rnorm(30)) 8 | expect_inherits(col1, "list") 9 | expect_inherits(col1$values, "character") 10 | expect_inherits(col1$legend, "character") 11 | expect_identical(length(col1$values), 30L) 12 | 13 | col2 <- topogram:::getColors(scales::col_numeric(palette = "Blues", domain = NULL), rnorm(40)) 14 | expect_inherits(col2, "list") 15 | expect_inherits(col2$values, "character") 16 | expect_inherits(col2$legend, "character") 17 | expect_identical(length(col2$values), 40L) 18 | 19 | expect_error(topogram:::getColors(list(), rnorm(40))) 20 | 21 | 22 | expect_inherits(topogram:::getLabels(world, "{name}"), "character") 23 | 24 | 25 | 26 | opt1 <- c( "pop_est", "gdp_md_est", "co2_emissions_1990", 27 | "co2_emissions_2020", "renewables_percent_electricity") 28 | opt2 <- list( 29 | "Population" = "pop_est", 30 | "GDP" = "gdp_md_est", 31 | "CO2 emissions (1990)" = "co2_emissions_1990", 32 | "CO2 emissions (2020)" = "co2_emissions_2020", 33 | "Share of electricity production from renewables" = "renewables_percent_electricity" 34 | ) 35 | opt3 <- list( 36 | list(text = "Population", value = "pop_est", palette = "viridis"), 37 | list(text = "GDP", value = "gdp_md_est", palette = "Blues", title = "AAA") 38 | ) 39 | 40 | 41 | expect_inherits(topogram:::get_topogram_options(opt1), "list") 42 | expect_inherits(topogram:::get_topogram_options(opt2), "list") 43 | expect_inherits(topogram:::get_topogram_options(opt3), "list") 44 | 45 | expect_error(topogram:::get_topogram_options(iris)) 46 | expect_error(topogram:::get_topogram_options(list(list(1)))) 47 | expect_error(topogram:::get_topogram_options(1)) 48 | 49 | 50 | expect_inherits(topogram:::get_select_options(opt1), "list") 51 | expect_inherits(topogram:::get_select_options(opt2), "list") 52 | expect_inherits(topogram:::get_select_options(opt3), "list") 53 | 54 | expect_error(topogram:::get_select_options(iris)) 55 | expect_error(topogram:::get_select_options(list(list(1)))) 56 | expect_error(topogram:::get_select_options(1)) 57 | -------------------------------------------------------------------------------- /inst/examples/proxy-value/app.R: -------------------------------------------------------------------------------- 1 | 2 | # ------------------------------------------------------------------------ 3 | # 4 | # Title : topogram - proxy : update value 5 | # By : Victor 6 | # Date : 2018-10-01 7 | # 8 | # ------------------------------------------------------------------------ 9 | 10 | 11 | 12 | 13 | # Packages ---------------------------------------------------------------- 14 | 15 | library( shiny ) 16 | library( rnaturalearth ) 17 | library( topogram ) 18 | library( dplyr ) 19 | 20 | 21 | 22 | 23 | # Data -------------------------------------------------------------------- 24 | 25 | # population data 26 | data("pop_france") 27 | 28 | 29 | # map data 30 | fr_dept <- ne_states(country = "france", returnclass = "sf") 31 | fr_dept <- fr_dept[fr_dept$type_en %in% "Metropolitan department", ] 32 | 33 | 34 | 35 | # join data 36 | fr_data <- left_join( 37 | x = fr_dept %>% select(name, iso_3166_2) %>% mutate(code_dep = gsub("FR-", "", iso_3166_2)), 38 | y = pop_france, 39 | by = c("code_dep" = "departements_code") 40 | ) 41 | 42 | 43 | 44 | 45 | 46 | # App --------------------------------------------------------------------- 47 | 48 | 49 | library(shiny) 50 | 51 | ui <- fluidPage( 52 | fluidRow( 53 | column( 54 | width = 10, offset = 1, 55 | tags$h2("topogram : update value with proxy"), 56 | radioButtons( 57 | inputId = "new_value", 58 | label = "Variable to use:", 59 | choices = grep(pattern = "femmes", x = names(fr_data), value = TRUE), 60 | inline = TRUE 61 | ), 62 | topogramOutput(outputId = "carto", height = "600px") 63 | ) 64 | ) 65 | ) 66 | 67 | server <- function(input, output, session) { 68 | 69 | # Initialize 70 | output$carto <- renderTopogram({ 71 | topogram( 72 | shape = fr_data, 73 | value = "femmes_0_a_19_ans", 74 | tooltip_label = ~name, 75 | n_iteration = 10, 76 | format_value = ",", 77 | d3_locale = "fr-FR" 78 | ) %>% add_legend( 79 | title = "Population", 80 | title_width = 200, 81 | orientation = "vertical", 82 | label_format = ",.2r" #.2s 83 | ) 84 | }) 85 | 86 | # Update 87 | observeEvent(input$new_value, { 88 | topogramProxy(shinyId = "carto") %>% 89 | proxy_update_value(new_value = input$new_value, legend_title = gsub("_", " ", input$new_value)) 90 | }, ignoreInit = TRUE) 91 | 92 | } 93 | 94 | shinyApp(ui, server) 95 | -------------------------------------------------------------------------------- /man/topogram_proxy_update.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/shiny.R 3 | \name{topogram_proxy_update} 4 | \alias{topogram_proxy_update} 5 | \title{Update topogram with proxy} 6 | \usage{ 7 | topogram_proxy_update( 8 | proxy, 9 | sfobj, 10 | value, 11 | label = "{value}", 12 | palette = "viridis", 13 | rescale_to = c(1, 1000), 14 | n_iteration = 10 15 | ) 16 | } 17 | \arguments{ 18 | \item{proxy}{A \code{\link[=topogram_proxy]{topogram_proxy()}} \code{htmlwidget} object or a valid Shiny output ID.} 19 | 20 | \item{sfobj}{An \code{sf} object. For the time being, shape must be projected in Mercator (CRS 4326).} 21 | 22 | \item{value}{Variable name to use to distort topology.} 23 | 24 | \item{label}{\code{glue} string to be used in tooltip, you can use HTML tags in it.} 25 | 26 | \item{palette}{Name of a color palette, such as \code{"viridis"}, \code{"Blues"}, ... 27 | Or a function to map data values to colors, see \code{\link[scales:col_numeric]{scales::col_numeric()}}.} 28 | 29 | \item{rescale_to}{Rescale value to distort topology to a specified range, use \code{NULL} to use values as is.} 30 | 31 | \item{n_iteration}{Number of iterations to run the algorithm for. Higher numbers distorts the areas closer to their associated value, 32 | at the cost of performance.} 33 | } 34 | \value{ 35 | A \code{topogram_proxy} \code{htmlwidget} object. 36 | } 37 | \description{ 38 | Use this in 'shiny' application to update an already generated \code{\link[=topogram]{topogram()}}. 39 | } 40 | \examples{ 41 | library(topogram) 42 | library(shiny) 43 | 44 | ui <- fluidPage( 45 | tags$h2("Update topogram with proxy"), 46 | radioButtons( 47 | inputId = "new_value", 48 | label = "Select a variable:", 49 | choices = names(world)[3:7], 50 | inline = TRUE 51 | ), 52 | topogramOutput(outputId = "ID", height = "800px") 53 | ) 54 | 55 | server <- function(input, output, session) { 56 | 57 | # Initialize the topogram (non reactive) 58 | output$ID <- renderTopogram({ 59 | topogram( 60 | sfobj = world, 61 | value = "pop_est", 62 | label = "{name} : {value}" 63 | ) \%>\% 64 | topogram_legend(title = "Population") 65 | }) 66 | 67 | # Update with proxy 68 | observeEvent(input$new_value, { 69 | topogram_proxy_update( 70 | "ID", world, 71 | value = input$new_value, 72 | label = "{name} : {value}" 73 | ) \%>\% 74 | topogram_legend(title = input$new_value) 75 | }, ignoreInit = TRUE) 76 | 77 | } 78 | 79 | if (interactive()) 80 | shinyApp(ui, server) 81 | } 82 | -------------------------------------------------------------------------------- /R/topogram_select.R: -------------------------------------------------------------------------------- 1 | 2 | #' @title Select menu to update [topogram()] 3 | #' 4 | #' @description Use in RMarkdown documents to update a [topogram()] dynamically. 5 | #' 6 | #' @param topogramId The `elementId` of the [topogram()] to update. 7 | #' @param values Parameters to construct cartograms, can be: 8 | #' * a `character` vector of variable to use 9 | #' * a named `list` where names will be used in select menu and values as variable 10 | #' * a `list` of `lists` where each sub-list can contain: `value` (variable), `text` (label for select menu), 11 | #' `palette`, `labels` (parameters specific for the variable considered) 12 | #' @inheritParams topogram 13 | #' 14 | #' @importFrom htmlwidgets createWidget sizingPolicy 15 | #' @importFrom stats setNames 16 | #' 17 | #' @export 18 | #' 19 | #' @example examples/selectmenu.R 20 | topogram_select <- function(topogramId, 21 | sfobj, 22 | values, 23 | label = "{value}", 24 | palette = "viridis", 25 | rescale_to = c(1, 1000), 26 | n_iteration = 10, 27 | width = NULL) { 28 | if (!is.character(topogramId)) 29 | stop("'topogramId' must be a character string.") 30 | topo_opts <- get_topogram_options(values, palette = palette, label = label) 31 | topo <- lapply( 32 | X = topo_opts, 33 | FUN = function(x) { 34 | values <- sfobj[[x$value]] 35 | colors <- getColors(x$palette, values) 36 | labels <- getLabels(sfobj, x$label, values) 37 | if (is.numeric(rescale_to) && length(rescale_to) == 2) { 38 | values <- scales::rescale(x = values, to = rescale_to) 39 | } 40 | dropNulls(list( 41 | values = values, 42 | colors = colors$values, 43 | labels = labels, 44 | labs = x$labs 45 | )) 46 | } 47 | ) 48 | data <- get_select_options(values) 49 | nms <- vapply(data, "[[", "value", FUN.VALUE = character(1)) 50 | x <- list( 51 | topogramId = topogramId, 52 | topo = setNames(topo, nms), 53 | data = data, 54 | n_iteration = n_iteration 55 | ) 56 | 57 | createWidget( 58 | name = "topogram_select", 59 | x, 60 | width = width, 61 | height = NULL, 62 | package = "topogram", 63 | elementId = NULL, 64 | sizingPolicy = sizingPolicy( 65 | defaultWidth = "100%", 66 | defaultHeight = "auto", 67 | knitr.figure = FALSE 68 | ) 69 | ) 70 | } 71 | 72 | 73 | topogram_select_html <- function(id, style, class, ...) { 74 | tags$select( 75 | id = id, 76 | class = class, 77 | style = style, 78 | ... 79 | ) 80 | } 81 | 82 | -------------------------------------------------------------------------------- /data-raw/world.R: -------------------------------------------------------------------------------- 1 | 2 | # ------------------------------------------------------------------------ 3 | # 4 | # Title : World polygons + some data 5 | # Date : 2021-11-05 6 | # 7 | # ------------------------------------------------------------------------ 8 | 9 | 10 | # Packages ---------------------------------------------------------------- 11 | 12 | library(data.table) 13 | library(sf) 14 | library(rnaturalearth) 15 | library(janitor) 16 | 17 | 18 | 19 | # Polygons ---------------------------------------------------------------- 20 | 21 | wrld <- st_as_sf(countries110) 22 | # doesn't support missing values ! 23 | wrld <- wrld[!is.na(wrld$pop_est), c("name", "iso_a3", "pop_est", "gdp_md_est")] 24 | # Antarctica is not a whole polygon 25 | wrld <- wrld[wrld$name != "Antarctica", ] 26 | 27 | 28 | 29 | # Data -------------------------------------------------------------------- 30 | 31 | # CO2 32 | # Source: https://ourworldindata.org/grapher/annual-co2-emissions-per-country?time=2018 33 | co2 <- fread(file = "data-raw/annual-co2-emissions-per-country.csv") 34 | setnames(co2, make_clean_names) 35 | setnames(co2, 1:2, c("country", "iso_a3")) 36 | co2[, annual_co2_emissions := as.numeric(annual_co2_emissions)] 37 | co2 <- dcast( 38 | data = co2, 39 | subset = .((year == 1990 | year == 2020) & iso_a3 != ""), 40 | formula = iso_a3 ~ year, 41 | value.var = "annual_co2_emissions" 42 | ) 43 | setnames(co2, 2:3, function(x) paste0("co2_emissions_", x)) 44 | setnafill(co2, fill = 0, cols = 2:3) 45 | wrld <- merge(x = wrld, y = co2, by = "iso_a3", all.x = TRUE, all.y = FALSE) 46 | 47 | 48 | # Share of electricity production from renewables 49 | # Source: https://ourworldindata.org/grapher/share-electricity-renewables?time=latest 50 | renewables <- fread(file = "data-raw/share-electricity-renewables.csv") 51 | setnames(renewables, make_clean_names) 52 | setnames(renewables, 1:2, c("country", "iso_a3")) 53 | # renewables[, renewables_percent_electricity := round(renewables_percent_electricity, 1)] 54 | renewables[renewables_percent_electricity > 100, renewables_percent_electricity := 100] 55 | renewables[renewables_percent_electricity < 0, renewables_percent_electricity := 0] 56 | wrld <- merge(x = wrld, y = renewables[year == 2019, list(iso_a3, renewables_percent_electricity)], by = "iso_a3", all.x = TRUE, all.y = FALSE) 57 | 58 | 59 | colSums(is.na(wrld)) 60 | # wrld <- wrld[!is.na(wrld$renewables_percent_electricity), ] 61 | # wrld <- wrld[!is.na(wrld$co2_emissions_2020), ] 62 | wrld$renewables_percent_electricity[is.na(wrld$renewables_percent_electricity)] <- 0 63 | wrld$co2_emissions_2020[is.na(wrld$co2_emissions_2020)] <- 0 64 | wrld$co2_emissions_1990[is.na(wrld$co2_emissions_1990)] <- 0 65 | 66 | 67 | 68 | # Use --------------------------------------------------------------------- 69 | 70 | world <- wrld 71 | usethis::use_data(world, overwrite = TRUE) 72 | -------------------------------------------------------------------------------- /vignettes/topogram.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "topogram" 3 | output: rmarkdown::html_vignette 4 | vignette: > 5 | %\VignetteIndexEntry{topogram} 6 | %\VignetteEngine{knitr::rmarkdown} 7 | %\VignetteEncoding{UTF-8} 8 | --- 9 | 10 | ```{r, include = FALSE} 11 | knitr::opts_chunk$set( 12 | collapse = TRUE, 13 | comment = "#>", 14 | message = FALSE, 15 | warning = FALSE 16 | ) 17 | ``` 18 | 19 | ```{r setup} 20 | library(topogram) 21 | library(htmltools) 22 | ``` 23 | 24 | Create continuous area cartograms with [`cartogram-chart`](https://github.com/vasturiano/cartogram-chart): 25 | 26 | ```{r topogram-basic} 27 | topogram(world, value = "pop_est") 28 | ``` 29 | 30 | First argument is an `sf` object containing geometries to visualize, the specify a numeric variable to use to distort those geometries. 31 | 32 | You can use a `glue` string to be used in tooltip, specify geographic projection to use, add labs and legend, ... 33 | 34 | ```{r topogram-options} 35 | world %>% 36 | topogram( 37 | value = "pop_est", 38 | label = "{name}: {format(pop_est, big.mark = ',')}", 39 | palette = scales::col_bin("Blues", bins = 20, domain = NULL) 40 | ) %>% 41 | topogram_legend( 42 | title = "Population", 43 | formatter = scales::label_comma() 44 | ) %>% 45 | topogram_labs( 46 | title = "World population", 47 | subtitle = "Population estimate for 2017", 48 | caption = tagList( 49 | "Data source:", 50 | tags$a( 51 | href = "https://www.naturalearthdata.com/", 52 | "NaturalEarth" 53 | ) 54 | ) 55 | ) 56 | ``` 57 | 58 | 59 | ## R markdown 60 | 61 | In Markdown documents, you can use `topogram_select()`, to add a menu to update variable used to distort topology interactively. First add select menu: 62 | 63 | ```{r markdown-select} 64 | topogram_select( 65 | topogramId = "ID", 66 | sfobj = world, 67 | values = list( 68 | "Population" = "pop_est", 69 | "GDP" = "gdp_md_est", 70 | "CO2 emissions (1990)" = "co2_emissions_1990", 71 | "CO2 emissions (2020)" = "co2_emissions_2020", 72 | "Share of electricity production from renewables" = "renewables_percent_electricity" 73 | ), 74 | label = "{name} : {value}" 75 | ) 76 | ``` 77 | 78 | Then create topogram: 79 | 80 | ```{r markdown-topogram} 81 | topogram( 82 | sfobj = world, 83 | value = "pop_est", 84 | label = "{name} : {value}", 85 | elementId = "ID" 86 | ) 87 | ``` 88 | 89 | 90 | ## Shiny 91 | 92 | In Shiny applications, a proxy method is available to update a topogram. 93 | 94 | ```{r shiny-proxy, eval=FALSE} 95 | function(input, output, session) { 96 | 97 | # Initialize the topogram (non reactive) 98 | output$ID <- renderTopogram({ 99 | topogram( 100 | sfobj = world, 101 | value = "pop_est", 102 | label = "{name} : {value}" 103 | ) %>% 104 | topogram_legend(title = "Population") 105 | }) 106 | 107 | # Update with proxy 108 | observeEvent(input$new_value, { 109 | topogram_proxy_update( 110 | "ID", world, 111 | value = input$new_value, 112 | label = "{name} : {value}" 113 | ) %>% 114 | topogram_legend(title = input$new_value) 115 | }, ignoreInit = TRUE) 116 | 117 | } 118 | ``` 119 | 120 | -------------------------------------------------------------------------------- /man/topogram_select.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/topogram_select.R 3 | \name{topogram_select} 4 | \alias{topogram_select} 5 | \title{Select menu to update \code{\link[=topogram]{topogram()}}} 6 | \usage{ 7 | topogram_select( 8 | topogramId, 9 | sfobj, 10 | values, 11 | label = "{value}", 12 | palette = "viridis", 13 | rescale_to = c(1, 1000), 14 | n_iteration = 10, 15 | width = NULL 16 | ) 17 | } 18 | \arguments{ 19 | \item{topogramId}{The \code{elementId} of the \code{\link[=topogram]{topogram()}} to update.} 20 | 21 | \item{sfobj}{An \code{sf} object. For the time being, shape must be projected in Mercator (CRS 4326).} 22 | 23 | \item{values}{Parameters to construct cartograms, can be: 24 | \itemize{ 25 | \item a \code{character} vector of variable to use 26 | \item a named \code{list} where names will be used in select menu and values as variable 27 | \item a \code{list} of \code{lists} where each sub-list can contain: \code{value} (variable), \code{text} (label for select menu), 28 | \code{palette}, \code{labels} (parameters specific for the variable considered) 29 | }} 30 | 31 | \item{label}{\code{glue} string to be used in tooltip, you can use HTML tags in it.} 32 | 33 | \item{palette}{Name of a color palette, such as \code{"viridis"}, \code{"Blues"}, ... 34 | Or a function to map data values to colors, see \code{\link[scales:col_numeric]{scales::col_numeric()}}.} 35 | 36 | \item{rescale_to}{Rescale value to distort topology to a specified range, use \code{NULL} to use values as is.} 37 | 38 | \item{n_iteration}{Number of iterations to run the algorithm for. Higher numbers distorts the areas closer to their associated value, 39 | at the cost of performance.} 40 | 41 | \item{width}{A numeric input in pixels.} 42 | } 43 | \description{ 44 | Use in RMarkdown documents to update a \code{\link[=topogram]{topogram()}} dynamically. 45 | } 46 | \examples{ 47 | library(topogram) 48 | library(htmltools) 49 | 50 | # normally, you would use the following in RMarkdown 51 | 52 | browsable(tagList( 53 | # Select menu 54 | topogram_select( 55 | topogramId = "ID", 56 | sfobj = world, 57 | values = list( 58 | "Population" = "pop_est", 59 | "GDP" = "gdp_md_est", 60 | "CO2 emissions (1990)" = "co2_emissions_1990", 61 | "CO2 emissions (2020)" = "co2_emissions_2020", 62 | "Share of electricity production from renewables" = "renewables_percent_electricity" 63 | ), 64 | label = "{name} : {value}" 65 | ), 66 | 67 | # Topogram 68 | topogram( 69 | sfobj = world, 70 | value = "pop_est", 71 | label = "{name} : {value}", 72 | elementId = "ID" 73 | ) 74 | ), value = interactive()) 75 | 76 | 77 | # specific options according to variables 78 | browsable(tagList( 79 | # Select menu 80 | topogram_select( 81 | topogramId = "ID", 82 | sfobj = world, 83 | values = list( 84 | list( 85 | text = "Population", 86 | value = "pop_est", 87 | palette = "Greens", 88 | label = "{name} : {value} inhabitants" 89 | ), 90 | list( 91 | text = "GDP", 92 | value = "gdp_md_est", 93 | palette = "Blues", 94 | label = "{name} : ${value}", 95 | labs = list(title = "GDP", subtitle = "estimate, in 2017") 96 | ) 97 | ), 98 | label = "{name} : {value}" 99 | ), 100 | 101 | # Topogram 102 | topogram( 103 | sfobj = world, 104 | value = "pop_est", 105 | elementId = "ID", 106 | # you have to specify parameters for initializing topogram 107 | palette = "Greens", 108 | label = "{name} : {value} inhabitants" 109 | ) 110 | ), value = interactive()) 111 | } 112 | -------------------------------------------------------------------------------- /srcjs/widgets/topogram.js: -------------------------------------------------------------------------------- 1 | import "widgets"; 2 | import Cartogram from "cartogram-chart"; 3 | import * as topojson from "topojson-client"; 4 | import * as proj1 from "d3-geo"; 5 | import * as proj2 from "d3-geo-projection"; 6 | const proj = { ...proj1, ...proj2 }; 7 | import * as utils from "../modules/utils"; 8 | import * as proxy from "../modules/proxy"; 9 | import "../modules/topogram.css"; 10 | 11 | HTMLWidgets.widget({ 12 | 13 | name: 'topogram', 14 | 15 | type: 'output', 16 | 17 | factory: function(el, width, height) { 18 | 19 | var topoEl = document.getElementById(el.id + "-topogram"); 20 | var widgetId = el.id; 21 | var carto, 22 | statesbbox, 23 | projection, 24 | topoWidth, 25 | topoHeight; 26 | 27 | var padding = 10; 28 | 29 | return { 30 | 31 | renderValue: function(x) { 32 | 33 | if (typeof carto !== "undefined") { 34 | topoEl.innerHTML = ""; 35 | } 36 | 37 | // Set labs (title, subtitle, caption) 38 | utils.setLabs(widgetId, x.labs, x.labsOpts); 39 | 40 | if (x.legend) { 41 | utils.setLegend(widgetId, x.legendOpts.content); 42 | } 43 | 44 | // sizing 45 | topoWidth = el.clientWidth - padding; 46 | topoHeight = el.clientHeight - padding; 47 | 48 | projection = proj[x.projection](); 49 | statesbbox = topojson.feature(x.sfobj, x.sfobj.objects.states); 50 | projection.fitExtent( 51 | [[padding, padding], [topoWidth, topoHeight]], 52 | statesbbox 53 | ); 54 | 55 | carto = Cartogram() 56 | .width(el.clientWidth) 57 | .height(el.clientHeight) 58 | .topoJson(x.sfobj) 59 | .topoObjectName("states") 60 | .projection(projection) 61 | .iterations(x.n_iteration) 62 | .value(function(d) { 63 | var value = d.properties[x.value]; 64 | if (value <= 0) { 65 | value = 0.001; 66 | } 67 | return value; 68 | }) 69 | .color(function(d) { 70 | return d.properties.topogram_color; 71 | }) 72 | .tooltipContent(function(d) { 73 | return d.properties.topogram_label; 74 | }) 75 | .valFormatter(function() { 76 | return ""; 77 | })( 78 | document.getElementById(el.id + "-topogram") 79 | ); 80 | 81 | if (HTMLWidgets.shinyMode) { 82 | carto.onClick(function(d) { 83 | if (x.layerId === null) { 84 | Shiny.onInputChange(el.id + "_click", d.properties); 85 | } else { 86 | Shiny.onInputChange( 87 | el.id + "_click", 88 | x.layerId[d.properties.topogram_id] 89 | ); 90 | } 91 | }); 92 | } 93 | 94 | }, 95 | 96 | getTopogram: function() { 97 | return carto; 98 | }, 99 | 100 | resize: function(width, height) { 101 | topoWidth = width - padding; 102 | topoHeight = height - padding; 103 | projection.fitExtent( 104 | [[padding, padding], [topoWidth, topoHeight]], 105 | statesbbox 106 | ); 107 | carto 108 | .width(width) 109 | .height(height) 110 | .projection(projection); 111 | } 112 | 113 | }; 114 | } 115 | }); 116 | 117 | if (HTMLWidgets.shinyMode) { 118 | Shiny.addCustomMessageHandler("proxy-topogram-values", proxy.updateValues); 119 | Shiny.addCustomMessageHandler("proxy-topogram-iteration", proxy.updateIteration); 120 | Shiny.addCustomMessageHandler("proxy-topogram-legend", proxy.updateLegend); 121 | Shiny.addCustomMessageHandler("proxy-topogram-labs", proxy.updateLabs); 122 | } 123 | -------------------------------------------------------------------------------- /inst/examples/eurostat-wine.R: -------------------------------------------------------------------------------- 1 | 2 | # ------------------------------------------------------------------------ 3 | # 4 | # Title : Wine consumption in Europe (via Eurostat) 5 | # By : Victor 6 | # Date : 2018-10-07 7 | # 8 | # ------------------------------------------------------------------------ 9 | 10 | 11 | 12 | 13 | # Packages ---------------------------------------------------------------- 14 | 15 | library(topogram) 16 | library(sf) 17 | library(eurostat) 18 | library(dplyr) 19 | # library(rnaturalearth) 20 | 21 | 22 | 23 | 24 | # Eurostat data ----------------------------------------------------------- 25 | 26 | eu_wine <- get_eurostat(id = "apro_cpb_wine", stringsAsFactors = FALSE) 27 | eu_wine <- label_eurostat(eu_wine, code = "geo") 28 | str(eu_wine) 29 | 30 | 31 | 32 | 33 | # Geographical data ------------------------------------------------------- 34 | 35 | # europe <- ne_countries(scale = 50, continent = "europe", returnclass = "sf") 36 | europe <- get_eurostat_geospatial(output_class = "sf", resolution = "10", nuts_level = 0, year = 2016) 37 | europe <- st_crop(europe, xmin = -20, ymin = 25, xmax = 35, ymax = 75) 38 | 39 | 40 | 41 | 42 | 43 | # Prepare data ------------------------------------------------------------ 44 | 45 | # Merge data 46 | europe <- europe %>% 47 | select(NUTS_NAME, id) %>% 48 | inner_join( 49 | y = eu_wine %>% filter( 50 | prod_bal == "P.D.O. - Red and rose wine", 51 | bal_item == "Gross human consumption (1000 hl)", 52 | format(time, "%Y") == "2013" 53 | ) %>% 54 | mutate(values = if_else(values == 0, 1, values)) %>% 55 | select(geo_code, name = geo, red_wine = values), 56 | by = c("id" = "geo_code") 57 | ) %>% 58 | inner_join( 59 | y = eu_wine %>% filter( 60 | prod_bal == "P.D.O. - white wine", 61 | bal_item == "Gross human consumption (1000 hl)", 62 | format(time, "%Y") == "2013" 63 | ) %>% 64 | mutate(values = if_else(values == 0, 1, values)) %>% 65 | select(geo_code, white_wine = values), 66 | by = c("id" = "geo_code") 67 | ) %>% 68 | inner_join( 69 | y = eu_wine %>% filter( 70 | prod_bal == "Red and rose wine", 71 | bal_item == "Gross human consumption per capita (lt/head)", 72 | format(time, "%Y") == "2013" 73 | ) %>% 74 | mutate(values = if_else(values == 0, 1, values)) %>% 75 | select(geo_code, red_wine_per_capita = values), 76 | by = c("id" = "geo_code") 77 | ) %>% 78 | inner_join( 79 | y = eu_wine %>% filter( 80 | prod_bal == "White wine", 81 | bal_item == "Gross human consumption per capita (lt/head)", 82 | format(time, "%Y") == "2013" 83 | ) %>% 84 | mutate(values = if_else(values == 0, 1, values)) %>% 85 | select(geo_code, white_wine_per_capita = values), 86 | by = c("id" = "geo_code") 87 | ) 88 | 89 | 90 | # europe$total_prod[europe$total_prod == 0] <- 10 91 | 92 | 93 | 94 | 95 | # Cartograms -------------------------------------------------------------- 96 | 97 | topogram( 98 | shape = europe, 99 | value = "red_wine", 100 | n_iteration = 60, 101 | format_value = ",", 102 | d3_locale = "fr-FR" 103 | ) 104 | topogram(shape = europe, value = c("red_wine", "white_wine"), n_iteration = 60) 105 | 106 | 107 | topogram( 108 | shape = europe, 109 | value = list( 110 | "Total vin rouge (en milliers d'hectolitres)" = "red_wine", 111 | "Total vin blanc (en milliers d'hectolitres)" = "white_wine", 112 | "Vin rouge par habitant (litre/hab)" = "red_wine_per_capita", 113 | "Vin blanc par habitant (litre/hab)" = "white_wine_per_capita" 114 | ), 115 | n_iteration = 40, 116 | format_value = ",", 117 | d3_locale = "fr-FR" 118 | ) %>% add_legend( 119 | title = "", 120 | title_width = 200, 121 | orientation = "vertical", 122 | label_format = ",.2r" #.2s 123 | ) %>% add_labs( 124 | title = "Consommation de vin en Europe", 125 | subtitle = "en 2013", 126 | caption = "Source Eurostat" 127 | ) 128 | 129 | 130 | -------------------------------------------------------------------------------- /inst/examples/eurostat-wine-rmd.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Consommation de vin en Europe" 3 | author: "Victor" 4 | date: "8 octobre 2018" 5 | output: html_document 6 | --- 7 | 8 | 9 | ## Données 10 | 11 | Les données viennent d'Eurostat et ont été récupérées via le package [`eurostat`](https://github.com/rOpenGov/eurostat). Les contours géographiques viennent également d'Eurostat. 12 | 13 | 14 | Pour pouvoir construire un cartogramme, les données doivent être au format `sf` et contenir une variable numérique ne contenant pas de valeurs manquantes ni de 0 pour déformer les formes géographiques ! 15 | 16 | 17 | ```{r message=FALSE, warning=FALSE, include=FALSE} 18 | # Packages ---------------------------------------------------------------- 19 | 20 | library(topogram) 21 | library(sf) 22 | library(eurostat) 23 | library(dplyr) 24 | 25 | 26 | 27 | 28 | # Eurostat data ----------------------------------------------------------- 29 | 30 | eu_wine <- get_eurostat(id = "apro_cpb_wine", stringsAsFactors = FALSE) 31 | eu_wine <- label_eurostat(eu_wine, code = "geo") 32 | # str(eu_wine) 33 | 34 | 35 | 36 | 37 | # Geographical data ------------------------------------------------------- 38 | 39 | # europe <- ne_countries(scale = 50, continent = "europe", returnclass = "sf") 40 | europe <- get_eurostat_geospatial(output_class = "sf", resolution = "10", nuts_level = 0, year = 2016) 41 | europe <- st_crop(europe, xmin = -20, ymin = 25, xmax = 35, ymax = 75) 42 | 43 | 44 | 45 | 46 | # Prepare data ------------------------------------------------------------ 47 | 48 | # Merge data 49 | europe <- europe %>% 50 | select(NUTS_NAME, id) %>% 51 | inner_join( 52 | y = eu_wine %>% filter( 53 | prod_bal == "P.D.O. - Red and rose wine", 54 | bal_item == "Gross human consumption (1000 hl)", 55 | format(time, "%Y") == "2013" 56 | ) %>% 57 | mutate(values = if_else(values == 0, 1, values)) %>% 58 | select(geo_code, name = geo, red_wine = values), 59 | by = c("id" = "geo_code") 60 | ) %>% 61 | inner_join( 62 | y = eu_wine %>% filter( 63 | prod_bal == "P.D.O. - white wine", 64 | bal_item == "Gross human consumption (1000 hl)", 65 | format(time, "%Y") == "2013" 66 | ) %>% 67 | mutate(values = if_else(values == 0, 1, values)) %>% 68 | select(geo_code, white_wine = values), 69 | by = c("id" = "geo_code") 70 | ) %>% 71 | inner_join( 72 | y = eu_wine %>% filter( 73 | prod_bal == "Red and rose wine", 74 | bal_item == "Gross human consumption per capita (lt/head)", 75 | format(time, "%Y") == "2013" 76 | ) %>% 77 | mutate(values = if_else(values == 0, 1, values)) %>% 78 | select(geo_code, red_wine_per_capita = values), 79 | by = c("id" = "geo_code") 80 | ) %>% 81 | inner_join( 82 | y = eu_wine %>% filter( 83 | prod_bal == "White wine", 84 | bal_item == "Gross human consumption per capita (lt/head)", 85 | format(time, "%Y") == "2013" 86 | ) %>% 87 | mutate(values = if_else(values == 0, 1, values)) %>% 88 | select(geo_code, white_wine_per_capita = values), 89 | by = c("id" = "geo_code") 90 | ) 91 | ``` 92 | 93 | 94 | 95 | ## Cartogramme 96 | 97 | Dans un document markdown, on peut passer plusieurs vairables comme argument à la fonction `topogram` pour ajouter un menu d\u00earoulant au-dessus du cartogramme : 98 | 99 | ```{r} 100 | topogram( 101 | shape = europe, 102 | value = list( 103 | "Total vin rouge (en milliers d'hectolitres)" = "red_wine", 104 | "Total vin blanc (en milliers d'hectolitres)" = "white_wine", 105 | "Vin rouge par habitant (litre/hab)" = "red_wine_per_capita", 106 | "Vin blanc par habitant (litre/hab)" = "white_wine_per_capita" 107 | ), 108 | n_iteration = 40, 109 | format_value = ",", 110 | d3_locale = "fr-FR", 111 | height = "600px" 112 | ) %>% add_legend( 113 | title = "", 114 | title_width = 200, 115 | orientation = "vertical", 116 | label_format = ",.2r" #.2s 117 | ) %>% add_labs( 118 | title = "Consommation de vin en Europe", 119 | subtitle = "en 2013", 120 | caption = "Source : Eurostat" 121 | ) 122 | ``` 123 | 124 | 125 | -------------------------------------------------------------------------------- /R/topogram.R: -------------------------------------------------------------------------------- 1 | #' @title Cartogram htmlwidget for visualizing geographical data by distorting a TopoJson topology 2 | #' 3 | #' @description Continuous area cartograms with `d3.js` and [`cartogram-chart`](https://github.com/vasturiano/cartogram-chart). 4 | #' 5 | #' @param sfobj An `sf` object. For the time being, shape must be projected in Mercator (CRS 4326). 6 | #' @param value Variable name to use to distort topology. 7 | #' @param label `glue` string to be used in tooltip, you can use HTML tags in it. 8 | #' @param palette Name of a color palette, such as `"viridis"`, `"Blues"`, ... 9 | #' Or a function to map data values to colors, see [scales::col_numeric()]. 10 | #' @param rescale_to Rescale value to distort topology to a specified range, use `NULL` to use values as is. 11 | #' @param n_iteration Number of iterations to run the algorithm for. Higher numbers distorts the areas closer to their associated value, 12 | #' at the cost of performance. 13 | #' @param projection Name of a projection, see available ones here: https://github.com/d3/d3-geo-projection. 14 | #' @param layerId A formula, the layer id to specify value returned by `input$_click` in 'shiny' application. 15 | #' @param width A numeric input in pixels. 16 | #' @param height A numeric input in pixels. 17 | #' @param elementId Use an explicit element ID for the widget. 18 | #' 19 | #' @return A [topogram()] `htmlwidget` object. 20 | #' 21 | #' @export 22 | #' 23 | #' @importFrom htmlwidgets createWidget JS sizingPolicy 24 | #' @importFrom geojsonio geojson_json geo2topo 25 | #' @importFrom stats model.frame 26 | #' @importFrom scales col_numeric rescale 27 | #' @importFrom glue glue_data 28 | #' 29 | topogram <- function(sfobj, 30 | value, 31 | label = "{value}", 32 | palette = "viridis", 33 | rescale_to = c(1, 1000), 34 | n_iteration = 10, 35 | projection = "geoMercator", 36 | layerId = NULL, 37 | width = NULL, 38 | height = NULL, 39 | elementId = NULL) { 40 | 41 | check_sf(sfobj) 42 | check_variables(sfobj, value) 43 | check_na(sfobj, value) 44 | 45 | if (!is.null(layerId)) { 46 | layerId <- model.frame(formula = layerId, data = sfobj)[[1]] 47 | } 48 | 49 | # add id for sfobjs 50 | sfobj$topogram_id <- seq_len(nrow(sfobj)) - 1 51 | 52 | # set colors 53 | values <- sfobj[[value]] 54 | values_range <- range(values, na.rm = TRUE) 55 | colors <- getColors(palette, values) 56 | sfobj$topogram_color <- colors$values 57 | 58 | # set label 59 | sfobj$topogram_label <- getLabels(sfobj, label, values) 60 | 61 | # rescale value 62 | if (is.numeric(rescale_to) && length(rescale_to) == 2) { 63 | sfobj[[value]] <- rescale(x = values, to = rescale_to) 64 | } 65 | 66 | # convert to geojson 67 | geo_json <- geojson_json(input = sfobj) 68 | 69 | # convert to topojson 70 | geo_topo <- geo2topo(x = geo_json, object_name = "states", quantization = 1e5) 71 | 72 | x <- list( 73 | sfobj = geo_topo, 74 | value = value, 75 | n_iteration = n_iteration, 76 | layerId = layerId, 77 | projection = projection, 78 | labs = FALSE, 79 | labsOpts = list(), 80 | legend = FALSE, 81 | legendOpts = list( 82 | labels = values_range, 83 | colors = colors$legend 84 | ) 85 | ) 86 | 87 | # create widget 88 | createWidget( 89 | name = "topogram", 90 | x = x, 91 | width = width, 92 | height = height, 93 | package = "topogram", 94 | elementId = elementId, 95 | sizingPolicy = sizingPolicy( 96 | defaultWidth = "100%", 97 | defaultHeight = "400px", 98 | viewer.defaultHeight = "100%", 99 | viewer.defaultWidth = "100%", 100 | browser.fill = TRUE, 101 | padding = 0, 102 | knitr.figure = FALSE 103 | ) 104 | ) 105 | } 106 | 107 | 108 | topogram_html <- function(id, style, class, ...) { 109 | tags$div( 110 | id = id, 111 | class = class, 112 | style = style, 113 | style = "position: relative;", 114 | tags$div( 115 | class = "topogram-heading", 116 | tags$div( 117 | id = paste0(id, "-title"), 118 | class = "topogram-title" 119 | ), 120 | tags$div( 121 | id = paste0(id, "-subtitle"), 122 | class = "topogram-subtitle" 123 | ) 124 | ), 125 | tags$div(id = paste0(id, "-topogram")), 126 | tags$p( 127 | id = paste0(id, "-caption"), 128 | class = "topogram-caption" 129 | ), 130 | tags$div( 131 | id = paste0(id, "-legend"), 132 | class = "topogram-legend" 133 | ) 134 | ) 135 | } 136 | -------------------------------------------------------------------------------- /R/shiny.R: -------------------------------------------------------------------------------- 1 | 2 | #' Shiny bindings for topogram 3 | #' 4 | #' Output and render functions for using topogram within Shiny 5 | #' applications and interactive Rmd documents. 6 | #' 7 | #' @param outputId output variable to read from 8 | #' @param width,height Must be a valid CSS unit (like \code{'100\%'}, 9 | #' \code{'400px'}, \code{'auto'}) or a number, which will be coerced to a 10 | #' string and have \code{'px'} appended. 11 | #' @param expr An expression that generates a topogram 12 | #' @param env The environment in which to evaluate \code{expr}. 13 | #' @param quoted Is \code{expr} a quoted expression (with \code{quote()})? This 14 | #' is useful if you want to save an expression in a variable. 15 | #' @param shinyId single-element character vector indicating the output ID of the 16 | #' chart to modify (if invoked from a Shiny module, the namespace will be added 17 | #' automatically) 18 | #' @param session the Shiny session object to which the chart belongs; usually the 19 | #' default value will suffice 20 | #' 21 | #' @name topogram-shiny 22 | #' 23 | #' @importFrom htmlwidgets shinyWidgetOutput shinyRenderWidget 24 | #' @importFrom shiny getDefaultReactiveDomain 25 | #' 26 | #' @export 27 | topogramOutput <- function(outputId, width = "100%", height = "400px"){ 28 | htmlwidgets::shinyWidgetOutput(outputId, "topogram", width, height, package = "topogram") 29 | } 30 | 31 | #' @rdname topogram-shiny 32 | #' @export 33 | renderTopogram <- function(expr, env = parent.frame(), quoted = FALSE) { 34 | if (!quoted) { expr <- substitute(expr) } # force quoted 35 | htmlwidgets::shinyRenderWidget(expr, topogramOutput, env, quoted = TRUE) 36 | } 37 | 38 | 39 | #' @rdname topogram-shiny 40 | #' @export 41 | topogram_proxy <- function(shinyId, session = shiny::getDefaultReactiveDomain()) { 42 | 43 | if (is.null(session)) { 44 | stop("topogramProxy must be called from the server function of a Shiny app") 45 | } 46 | 47 | if (!is.null(session$ns) && nzchar(session$ns(NULL)) && substring(shinyId, 1, nchar(session$ns(""))) != session$ns("")) { 48 | shinyId <- session$ns(shinyId) 49 | } 50 | 51 | structure( 52 | list( 53 | session = session, 54 | id = shinyId, 55 | x = list() 56 | ), 57 | class = "topogram_Proxy" 58 | ) 59 | } 60 | 61 | 62 | #' Call a proxy method 63 | #' 64 | #' @param proxy A \code{topogramProxy} \code{htmlwidget} object. 65 | #' @param name Proxy method. 66 | #' @param l Arguments passed to method. 67 | #' 68 | #' @return A \code{topogramProxy} \code{htmlwidget} object. 69 | #' @noRd 70 | .topogram_proxy <- function(proxy, name, l) { 71 | proxy$session$sendCustomMessage( 72 | type = sprintf("proxy-topogram-%s", name), 73 | message = list(id = proxy$id, data = dropNulls(l)) 74 | ) 75 | proxy 76 | } 77 | 78 | 79 | 80 | 81 | #' @title Update topogram with proxy 82 | #' 83 | #' @description Use this in 'shiny' application to update an already generated [topogram()]. 84 | #' 85 | #' @param proxy A [topogram_proxy()] `htmlwidget` object or a valid Shiny output ID. 86 | #' @inheritParams topogram 87 | #' 88 | #' @return A `topogram_proxy` `htmlwidget` object. 89 | #' @export 90 | #' 91 | #' @example examples/proxy-update.R 92 | topogram_proxy_update <- function(proxy, 93 | sfobj, 94 | value, 95 | label = "{value}", 96 | palette = "viridis", 97 | rescale_to = c(1, 1000), 98 | n_iteration = 10) { 99 | if (is.character(proxy)) { 100 | proxy <- topogram_proxy(proxy) 101 | } 102 | if (is.character(value) && length(value) == 1) { 103 | values <- sfobj[[value]] 104 | } else if (is.vector(value) && is.numeric(value)) { 105 | values <- value 106 | } else { 107 | stop("topogram_proxy_update: 'value' must a character of length 1 or a numeric vector.", call. = FALSE) 108 | } 109 | colors <- getColors(palette, values) 110 | proxy$x$legendOpts = list( 111 | labels = range(values, na.rm = TRUE), 112 | colors = colors$legend 113 | ) 114 | if (is.numeric(rescale_to) && length(rescale_to) == 2) { 115 | values <- scales::rescale(x = values, to = rescale_to) 116 | } 117 | .topogram_proxy(proxy, "values", l = list( 118 | values = values, 119 | colors = colors$values, 120 | labels = getLabels(sfobj, label, values), 121 | n_iteration = n_iteration 122 | )) 123 | } 124 | 125 | 126 | 127 | #' @title Update number of iteration with proxy 128 | #' 129 | #' @description Use this in 'shiny' application to update an already generated [topogram()]. 130 | #' 131 | #' @param proxy A `topogram_proxy` `htmlwidget` object. 132 | #' @inheritParams topogram 133 | #' 134 | #' @return A `topogram_proxy` `htmlwidget` object. 135 | #' @export 136 | #' 137 | #' @example examples/proxy-iteration.R 138 | topogram_proxy_iteration <- function(proxy, n_iteration) { 139 | if (is.character(proxy)) { 140 | proxy <- topogram_proxy(proxy) 141 | } 142 | stopifnot(is.numeric(n_iteration) && length(n_iteration) == 1) 143 | .topogram_proxy(proxy, "iteration", list(n_iteration = n_iteration)) 144 | } 145 | 146 | 147 | -------------------------------------------------------------------------------- /inst/examples/eurostat-wine-app.R: -------------------------------------------------------------------------------- 1 | 2 | # ------------------------------------------------------------------------ 3 | # 4 | # Title : Wine consumption in Europe (via Eurostat) 5 | # By : Victor 6 | # Date : 2018-10-07 7 | # 8 | # ------------------------------------------------------------------------ 9 | 10 | 11 | 12 | 13 | # Packages ---------------------------------------------------------------- 14 | 15 | library(topogram) 16 | library(sf) 17 | library(eurostat) 18 | library(dplyr) 19 | # library(rnaturalearth) 20 | 21 | 22 | 23 | 24 | # Eurostat data ----------------------------------------------------------- 25 | 26 | eu_wine <- get_eurostat(id = "apro_cpb_wine", stringsAsFactors = FALSE) 27 | eu_wine <- label_eurostat(eu_wine, code = "geo") 28 | str(eu_wine) 29 | 30 | 31 | 32 | 33 | # Geographical data ------------------------------------------------------- 34 | 35 | # europe <- ne_countries(scale = 50, continent = "europe", returnclass = "sf") 36 | europe <- get_eurostat_geospatial(output_class = "sf", resolution = "10", nuts_level = 0, year = 2016) 37 | europe <- st_crop(europe, xmin = -20, ymin = 25, xmax = 35, ymax = 75) 38 | 39 | 40 | 41 | 42 | 43 | # Prepare data ------------------------------------------------------------ 44 | 45 | # Merge data 46 | europe <- europe %>% 47 | select(NUTS_NAME, id) %>% 48 | inner_join( 49 | y = eu_wine %>% filter( 50 | prod_bal == "P.D.O. - Red and rose wine", 51 | bal_item == "Gross human consumption (1000 hl)", 52 | format(time, "%Y") == "2013" 53 | ) %>% 54 | mutate(values = if_else(values == 0, 1, values)) %>% 55 | select(geo_code, name = geo, red_wine = values), 56 | by = c("id" = "geo_code") 57 | ) %>% 58 | inner_join( 59 | y = eu_wine %>% filter( 60 | prod_bal == "P.D.O. - white wine", 61 | bal_item == "Gross human consumption (1000 hl)", 62 | format(time, "%Y") == "2013" 63 | ) %>% 64 | mutate(values = if_else(values == 0, 1, values)) %>% 65 | select(geo_code, white_wine = values), 66 | by = c("id" = "geo_code") 67 | ) %>% 68 | inner_join( 69 | y = eu_wine %>% filter( 70 | prod_bal == "Red and rose wine", 71 | bal_item == "Gross human consumption per capita (lt/head)", 72 | format(time, "%Y") == "2013" 73 | ) %>% 74 | mutate(values = if_else(values == 0, 1, values)) %>% 75 | select(geo_code, red_wine_per_capita = values), 76 | by = c("id" = "geo_code") 77 | ) %>% 78 | inner_join( 79 | y = eu_wine %>% filter( 80 | prod_bal == "White wine", 81 | bal_item == "Gross human consumption per capita (lt/head)", 82 | format(time, "%Y") == "2013" 83 | ) %>% 84 | mutate(values = if_else(values == 0, 1, values)) %>% 85 | select(geo_code, white_wine_per_capita = values), 86 | by = c("id" = "geo_code") 87 | ) 88 | 89 | 90 | # europe$total_prod[europe$total_prod == 0] <- 10 91 | 92 | 93 | 94 | # App shiny --------------------------------------------------------------- 95 | 96 | library(shiny) 97 | 98 | liste_vars <- list( 99 | "Total vin rouge (en milliers d'hectolitres)" = "red_wine", 100 | "Total vin blanc (en milliers d'hectolitres)" = "white_wine", 101 | "Vin rouge par habitant (litre/hab)" = "red_wine_per_capita", 102 | "Vin blanc par habitant (litre/hab)" = "white_wine_per_capita" 103 | ) 104 | 105 | ui <- fluidPage( 106 | fluidRow( 107 | column( 108 | width = 10, offset = 1, 109 | tags$h2("Exemple de cartogramme"), 110 | fluidRow( 111 | column( 112 | width = 3, 113 | tags$br(), 114 | radioButtons( 115 | inputId = "var", 116 | label = "Variable :", 117 | choices = liste_vars, 118 | selected = "red_wine" 119 | ), 120 | sliderInput( 121 | inputId = "n_iteration", 122 | label = "Nombre d'it\u00e9rations", 123 | min = 1, max = 60, value = 20 124 | ) 125 | ), 126 | column( 127 | width = 9, 128 | topogramOutput(outputId = "carte", height = "650px") 129 | ) 130 | ) 131 | ) 132 | ) 133 | ) 134 | 135 | server <- function(input, output, session) { 136 | 137 | # Initialisation de la carte 138 | output$carte <- renderTopogram({ 139 | topogram( 140 | shape = europe, 141 | value = "red_wine", 142 | n_iteration = 20, 143 | format_value = ",", 144 | d3_locale = "fr-FR" 145 | ) %>% add_legend( 146 | title = "Total vin rouge (en milliers d'hectolitres)", 147 | title_width = 200, 148 | orientation = "vertical", 149 | label_format = ",.2r" #.2s 150 | ) %>% add_labs( 151 | title = "Consommation de vin en Europe", 152 | subtitle = "en 2013", 153 | caption = "Source : Eurostat" 154 | ) 155 | }) 156 | 157 | # Maj de la carte 158 | observeEvent(list(input$var, input$n_iteration), { 159 | topogramProxy(shinyId = "carte") %>% 160 | proxy_update_iteration(n_iteration = input$n_iteration) %>% 161 | proxy_update_value( 162 | new_value = input$var, 163 | legend_title = names(liste_vars)[unlist(liste_vars, use.names = FALSE) == input$var] 164 | ) 165 | }) 166 | 167 | } 168 | 169 | shinyApp(ui, server) 170 | -------------------------------------------------------------------------------- /R/topo-extras.R: -------------------------------------------------------------------------------- 1 | 2 | #' Utility function to create topogram parameters 3 | #' 4 | #' @param topo A \code{topogram} \code{htmlwidget} object. 5 | #' @param name Slot's name to edit 6 | #' @param ... Arguments for the slot 7 | #' 8 | #' @return A \code{topogram} \code{htmlwidget} object. 9 | #' 10 | #' @importFrom utils modifyList 11 | #' 12 | #' @noRd 13 | .topo_opt <- function(topo, name, ...) { 14 | 15 | if (is.null(topo$x[[name]])) { 16 | topo$x[[name]] <- list(...) 17 | } else { 18 | topo$x[[name]] <- modifyList(x = topo$x[[name]], val = list(...), keep.null = TRUE) 19 | } 20 | 21 | return(topo) 22 | } 23 | 24 | 25 | 26 | #' @title Labs for topogram widget 27 | #' 28 | #' @description Add title, subtitle and caption to a topogram. 29 | #' 30 | #' @param topo A [topogram()] `htmlwidget` object. 31 | #' @param title Main title. 32 | #' @param subtitle Subtitle. 33 | #' @param caption Brief explanation of the source of the data. 34 | #' 35 | #' @return A [topogram()] / [topogram_proxy()] `htmlwidget` object. 36 | #' 37 | #' @export 38 | #' 39 | #' @importFrom htmltools doRenderTags 40 | #' 41 | #' @example examples/labs.R 42 | topogram_labs <- function(topo, title = NULL, subtitle = NULL, caption = NULL) { 43 | check_topogram(topo) 44 | topo$x$labs <- TRUE 45 | if (!is.null(title)) 46 | title <- doRenderTags(title) 47 | if (!is.null(subtitle)) 48 | subtitle <- doRenderTags(subtitle) 49 | if (!is.null(caption)) 50 | caption <- doRenderTags(caption) 51 | if (inherits(topo, "topogram_Proxy")) { 52 | .topogram_proxy(topo, "labs", l = list( 53 | title = title, subtitle = subtitle, caption = caption 54 | )) 55 | } else { 56 | .topo_opt(topo, "labsOpts", title = title, subtitle = subtitle, caption = caption) 57 | } 58 | } 59 | 60 | 61 | 62 | 63 | #' @title Legend for topogram widget 64 | #' 65 | #' @description Add a gradient legend in a [topogram()] widget. 66 | #' 67 | #' @param topo A [topogram()] / [topogram_proxy()] `htmlwidget` object. 68 | #' @param colors Vector of colors used in legend, default is to use colors used in [topogram()]. 69 | #' @param labels Labels to display for values, default is to use range of values used in [topogram()]. 70 | #' @param formatter Function to format labels, like [scales::label_number()]. 71 | #' @param title Title for the legend. 72 | #' @param direction Direction: horizontal or vertical. 73 | #' @param height,width Height, width for legend. For gradient legend it 74 | #' represent the size of the dradient according to direction. 75 | #' 76 | #' @return A [topogram()] / [topogram_proxy()] `htmlwidget` object. 77 | #' 78 | #' @export 79 | #' 80 | #' @importFrom htmltools tags tagList doRenderTags 81 | #' 82 | #' @example examples/legend.R 83 | topogram_legend <- function(topo, 84 | colors = NULL, 85 | labels = NULL, 86 | formatter = NULL, 87 | title = NULL, 88 | direction = c("h", "v"), 89 | height = "250px", 90 | width = "250px") { 91 | check_topogram(topo) 92 | direction <- match.arg(direction) 93 | if (is.null(colors)) 94 | colors <- topo$x$legendOpts$colors 95 | if (is.null(labels)) 96 | labels <- topo$x$legendOpts$labels 97 | if (is.function(formatter)) 98 | labels <- formatter(labels) 99 | topo$x$legend <- TRUE 100 | content <- create_legend( 101 | colors = colors, 102 | labels = labels, 103 | title= title, 104 | direction = direction, 105 | height = height, 106 | width = width 107 | ) 108 | if (inherits(topo, "topogram_Proxy")) { 109 | .topogram_proxy(topo, "legend", l = list( 110 | content = content 111 | )) 112 | } else { 113 | .topo_opt( 114 | topo = topo, 115 | name = "legendOpts", 116 | content = content 117 | ) 118 | } 119 | } 120 | 121 | #' @importFrom scales colour_ramp 122 | #' @importFrom htmltools css validateCssUnit tagList tags doRenderTags 123 | create_legend <- function(colors, 124 | labels, 125 | title = NULL, 126 | direction = c("h", "v"), 127 | height = "250px", width = "250px") { 128 | direction <- match.arg(direction) 129 | height <- validateCssUnit(height) 130 | width <- validateCssUnit(width) 131 | colors <- colour_ramp(colors)(seq(0, 1, length = 100)) 132 | if (direction == "h") { 133 | tag_legend <- tagList( 134 | tags$div( 135 | class = "topogram-legend-gradient", 136 | style = css( 137 | height = "12px", 138 | width = width, 139 | background = linear_gradient(colors) 140 | ) 141 | ), 142 | tags$div( 143 | class = "topogram-legend-labels-h", 144 | tags$span(labels[1]), 145 | tags$span(labels[2], style = "float: right;") 146 | ) 147 | ) 148 | } else { 149 | tag_legend <- tags$div( 150 | style = "width: 100%;", 151 | tags$div( 152 | class = "topogram-legend-gradient", 153 | style = css( 154 | height = height, 155 | width = "12px", 156 | float = "left", 157 | background = linear_gradient(colors, direction = "v") 158 | ) 159 | ), 160 | tags$div( 161 | style = paste("height: ", height, ";"), 162 | class = "topogram-legend-labels-v", 163 | tags$div(labels[1]), 164 | tags$div(labels[2], class = "topogram-legend-labels-v-2") 165 | ) 166 | ) 167 | } 168 | doRenderTags(tagList( 169 | if (!is.null(title)) { 170 | tags$div( 171 | title, 172 | class = "topogram-legend-title" 173 | ) 174 | }, 175 | tags$div( 176 | class = "topogram-legend-colors", 177 | tag_legend 178 | ) 179 | )) 180 | } 181 | 182 | -------------------------------------------------------------------------------- /R/utils.R: -------------------------------------------------------------------------------- 1 | 2 | dropNulls <- function(x) { 3 | x[!vapply(x, is.null, FUN.VALUE = logical(1))] 4 | } 5 | 6 | check_sf <- function(obj) { 7 | if (!inherits(obj, "sf")) { 8 | stop("'shape' must be an `sf` object.", call. = FALSE) 9 | } 10 | } 11 | 12 | check_topogram <- function(topo) { 13 | if (!inherits(topo, c("topogram", "topogram_Proxy"))) { 14 | stop("topo must be a topogram() object.", call. = FALSE) 15 | } 16 | } 17 | 18 | check_variables <- function(data, vars) { 19 | vars <- unlist(vars, use.names = FALSE, recursive = TRUE) 20 | if (!all(vars %in% names(data))) { 21 | stop("'value' must be valid variable(s) name(s).", call. = FALSE) 22 | } 23 | } 24 | 25 | check_na <- function(data, vars) { 26 | vars <- unlist(vars, use.names = FALSE, recursive = TRUE) 27 | if (anyNA(data[, vars])) { 28 | stop("topogram does not support missing values.", call. = FALSE) 29 | } 30 | } 31 | 32 | 33 | # gradient 34 | linear_gradient <- function(cols, direction = c("h", "v")) { 35 | direction <- match.arg(direction) 36 | x <- round(seq(from = 0, to = 100, length.out = length(cols)+1)) 37 | ind <- c(1, rep(seq_along(x)[-c(1, length(x))], each = 2), length(x)) 38 | m <- matrix(data = paste0(x[ind], "%"), ncol = 2, byrow = TRUE) 39 | res <- lapply( 40 | X = seq_len(nrow(m)), 41 | FUN = function(i) { 42 | paste(paste(cols[i], m[i, 1]), paste(cols[i], m[i, 2]), sep = ", ") 43 | } 44 | ) 45 | res <- unlist(res) 46 | res <- paste(res, collapse = ", ") 47 | if (direction == "h") { 48 | paste0("linear-gradient(to right, ", res, ");") 49 | } else { 50 | paste0("linear-gradient(to bottom, ", res, ");") 51 | } 52 | } 53 | 54 | 55 | #' @importFrom scales col_numeric 56 | #' @importFrom rlang is_function is_character 57 | getColors <- function(palette, values) { 58 | values_range <- range(values, na.rm = TRUE) 59 | if (is_character(palette)) { 60 | col_fun <- scales::col_numeric( 61 | palette = palette, 62 | domain = values_range 63 | ) 64 | topogram_color <- col_fun(values) 65 | colors <- col_fun(seq(from = values_range[1], to = values_range[2], length.out = 20)) 66 | } else if (is_function(palette)) { 67 | topogram_color <- palette(values) 68 | colors <- palette(seq(from = values_range[1], to = values_range[2], length.out = 20)) 69 | } else { 70 | stop( 71 | "'palette' must be a character (palette name) or a function (like ?scales::col_numeric)", 72 | call. = FALSE 73 | ) 74 | } 75 | list(values = topogram_color, legend = colors) 76 | } 77 | 78 | #' @importFrom htmltools doRenderTags tags 79 | #' @importFrom glue glue_data 80 | getLabels <- function(sfobj, label, values) { 81 | label <- doRenderTags(tags$div( 82 | style = "margin-top:-25px;", 83 | label 84 | )) 85 | glue::glue_data(sfobj, label, value = values) 86 | } 87 | 88 | 89 | #' @importFrom rlang is_character is_list is_named is_null %||% 90 | get_topogram_options <- function(x, palette = "viridis", label = "{value]") { 91 | if (is_character(x)) { 92 | lapply( 93 | X = x, 94 | FUN = function(value) { 95 | list(value = value, palette = palette, label = label) 96 | } 97 | ) 98 | } else if (is_list(x) && is_named(x)) { 99 | if (!is_character(x[[1]], n = 1)) { 100 | stop( 101 | "topogram_select: if 'values' is a list, items must be character of length 1.", 102 | call. = FALSE 103 | ) 104 | } 105 | lapply( 106 | X = unname(x), 107 | FUN = function(value) { 108 | list(value = value, palette= palette, label = label) 109 | } 110 | ) 111 | } else if (is_list(x) && is_list(x[[1]])) { 112 | if (!is_named(x[[1]])) { 113 | stop( 114 | "topogram_select: 'values' must be either a character vector, or a named list, or a list of lists", 115 | call. = FALSE 116 | ) 117 | } 118 | if (is_null(x[[1]]$value)) { 119 | stop( 120 | "topogram_select: if 'values' is a list of lists, it must have a `value` field", 121 | call. = FALSE 122 | ) 123 | } 124 | lapply( 125 | X = x, 126 | FUN = function(.list) { 127 | .list$palette <- .list$palette %||% palette 128 | .list$label <- .list$label %||% label 129 | return(.list) 130 | } 131 | ) 132 | } else { 133 | stop( 134 | "topogram_select: 'values' must be either a character vector, or a named list, or a list of lists", 135 | call. = FALSE 136 | ) 137 | } 138 | } 139 | 140 | get_select_options <- function(x) { 141 | if (is_character(x)) { 142 | lapply( 143 | X = x, 144 | FUN = function(value) { 145 | list(value = value, text = value) 146 | } 147 | ) 148 | } else if (is_list(x) && is_named(x)) { 149 | if (!is_character(x[[1]], n = 1)) { 150 | stop( 151 | "topogram_select: if 'values' is a list, items mustbe character of length 1.", 152 | call. = FALSE 153 | ) 154 | } 155 | lapply( 156 | X = seq_along(x), 157 | FUN = function(i) { 158 | list(value = x[[i]], text = names(x)[i]) 159 | } 160 | ) 161 | } else if (is_list(x) && is_list(x[[1]])) { 162 | if (!is_named(x[[1]])) { 163 | stop( 164 | "topogram_select: 'values' must be either a character vector, or a named list, or a list of lists", 165 | call. = FALSE 166 | ) 167 | } 168 | if (is_null(x[[1]]$value)) { 169 | stop( 170 | "topogram_select: if 'values' is a list of lists, it must have a `value` field", 171 | call. = FALSE 172 | ) 173 | } 174 | lapply( 175 | X = x, 176 | FUN = function(l) { 177 | list(value = l$value, text = l$text %||% l$value) 178 | } 179 | ) 180 | } else { 181 | stop( 182 | "topogram_select: 'values' must be either a character vector, or a named list, or a list of lists", 183 | call. = FALSE 184 | ) 185 | } 186 | } 187 | 188 | -------------------------------------------------------------------------------- /srcjs/modules/slimselect.min.css: -------------------------------------------------------------------------------- 1 | .ss-main{position:relative;display:inline-block;user-select:none;color:#666;width:100%}.ss-main .ss-single-selected{display:flex;cursor:pointer;width:100%;height:30px;padding:6px;border:1px solid #dcdee2;border-radius:4px;background-color:#fff;outline:0;box-sizing:border-box;transition:background-color .2s}.ss-main .ss-single-selected.ss-disabled{background-color:#dcdee2;cursor:not-allowed}.ss-main .ss-single-selected.ss-open-above{border-top-left-radius:0;border-top-right-radius:0}.ss-main .ss-single-selected.ss-open-below{border-bottom-left-radius:0;border-bottom-right-radius:0}.ss-main .ss-single-selected .placeholder{flex:1 1 100%;text-align:left;width:calc(100% - 30px);line-height:1em;-webkit-user-select:none;-moz-user-select:none;-ms-user-select:none;user-select:none}.ss-main .ss-single-selected .placeholder,.ss-main .ss-single-selected .placeholder *{display:flex;align-items:center;overflow:hidden;text-overflow:ellipsis;white-space:nowrap}.ss-main .ss-single-selected .placeholder *{width:auto}.ss-main .ss-single-selected .placeholder .ss-disabled{color:#dedede}.ss-main .ss-single-selected .ss-deselect{display:flex;align-items:center;justify-content:flex-end;flex:0 1 auto;margin:0 6px;font-weight:700}.ss-main .ss-single-selected .ss-deselect.ss-hide{display:none}.ss-main .ss-single-selected .ss-arrow{display:flex;align-items:center;justify-content:flex-end;flex:0 1 auto;margin:0 6px}.ss-main .ss-single-selected .ss-arrow span{border:solid #666;border-width:0 2px 2px 0;display:inline-block;padding:3px;transition:transform .2s,margin .2s}.ss-main .ss-single-selected .ss-arrow span.arrow-up{transform:rotate(-135deg);margin:3px 0 0}.ss-main .ss-single-selected .ss-arrow span.arrow-down{transform:rotate(45deg);margin:-3px 0 0}.ss-main .ss-multi-selected{display:flex;flex-direction:row;cursor:pointer;min-height:30px;width:100%;padding:0 0 0 3px;border:1px solid #dcdee2;border-radius:4px;background-color:#fff;outline:0;box-sizing:border-box;transition:background-color .2s}.ss-main .ss-multi-selected.ss-disabled{background-color:#dcdee2;cursor:not-allowed}.ss-main .ss-multi-selected.ss-disabled .ss-values .ss-disabled{color:#666}.ss-main .ss-multi-selected.ss-disabled .ss-values .ss-value .ss-value-delete{cursor:not-allowed}.ss-main .ss-multi-selected.ss-open-above{border-top-left-radius:0;border-top-right-radius:0}.ss-main .ss-multi-selected.ss-open-below{border-bottom-left-radius:0;border-bottom-right-radius:0}.ss-main .ss-multi-selected .ss-values{display:flex;flex-wrap:wrap;justify-content:flex-start;flex:1 1 100%;width:calc(100% - 30px)}.ss-main .ss-multi-selected .ss-values .ss-disabled{display:flex;padding:4px 5px;margin:2px 0;line-height:1em;align-items:center;width:100%;color:#dedede;overflow:hidden;text-overflow:ellipsis;white-space:nowrap}@keyframes scaleIn{0%{transform:scale(0);opacity:0}to{transform:scale(1);opacity:1}}@keyframes scaleOut{0%{transform:scale(1);opacity:1}to{transform:scale(0);opacity:0}}.ss-main .ss-multi-selected .ss-values .ss-value{display:flex;user-select:none;align-items:center;font-size:12px;padding:3px 5px;margin:3px 5px 3px 0;color:#fff;background-color:#5897fb;border-radius:4px;animation-name:scaleIn;animation-duration:.2s;animation-timing-function:ease-out;animation-fill-mode:both}.ss-main .ss-multi-selected .ss-values .ss-value.ss-out{animation-name:scaleOut;animation-duration:.2s;animation-timing-function:ease-out}.ss-main .ss-multi-selected .ss-values .ss-value .ss-value-delete{margin:0 0 0 5px;cursor:pointer}.ss-main .ss-multi-selected .ss-add{display:flex;flex:0 1 3px;margin:9px 12px 0 5px}.ss-main .ss-multi-selected .ss-add .ss-plus{display:flex;justify-content:center;align-items:center;background:#666;position:relative;height:10px;width:2px;transition:transform .2s}.ss-main .ss-multi-selected .ss-add .ss-plus:after{background:#666;content:"";position:absolute;height:2px;width:10px;left:-4px;top:4px}.ss-main .ss-multi-selected .ss-add .ss-plus.ss-cross{transform:rotate(45deg)}.ss-content{position:absolute;width:100%;margin:-1px 0 0;box-sizing:border-box;border:1px solid #dcdee2;z-index:1010;background-color:#fff;transform-origin:center top;transition:transform .2s,opacity .2s;opacity:0;transform:scaleY(0)}.ss-content.ss-open{display:block;opacity:1;transform:scaleY(1)}.ss-content .ss-search{display:flex;flex-direction:row;padding:8px 8px 6px}.ss-content .ss-search.ss-hide,.ss-content .ss-search.ss-hide input{height:0;opacity:0;padding:0;margin:0}.ss-content .ss-search input{display:inline-flex;font-size:inherit;line-height:inherit;flex:1 1 auto;width:100%;min-width:0;height:30px;padding:6px 8px;margin:0;border:1px solid #dcdee2;border-radius:4px;background-color:#fff;outline:0;text-align:left;box-sizing:border-box;-webkit-box-sizing:border-box;-webkit-appearance:textfield}.ss-content .ss-search input::placeholder{color:#8a8a8a;vertical-align:middle}.ss-content .ss-search input:focus{box-shadow:0 0 5px #5897fb}.ss-content .ss-search .ss-addable{display:inline-flex;justify-content:center;align-items:center;cursor:pointer;font-size:22px;font-weight:700;flex:0 0 30px;height:30px;margin:0 0 0 8px;border:1px solid #dcdee2;border-radius:4px;box-sizing:border-box}.ss-content .ss-addable{padding-top:0}.ss-content .ss-list{max-height:200px;overflow-x:hidden;overflow-y:auto;text-align:left}.ss-content .ss-list .ss-optgroup .ss-optgroup-label{padding:6px 10px;font-weight:700}.ss-content .ss-list .ss-optgroup .ss-option{padding:6px 6px 6px 25px}.ss-content .ss-list .ss-optgroup-label-selectable{cursor:pointer}.ss-content .ss-list .ss-optgroup-label-selectable:hover{color:#fff;background-color:#5897fb}.ss-content .ss-list .ss-option{padding:6px 10px;cursor:pointer;user-select:none}.ss-content .ss-list .ss-option *{display:inline-block}.ss-content .ss-list .ss-option.ss-highlighted,.ss-content .ss-list .ss-option:hover{color:#fff;background-color:#5897fb}.ss-content .ss-list .ss-option.ss-disabled{cursor:not-allowed;color:#dedede;background-color:#fff}.ss-content .ss-list .ss-option:not(.ss-disabled).ss-option-selected{color:#666;background-color:rgba(88,151,251,.1)}.ss-content .ss-list .ss-option.ss-hide{display:none}.ss-content .ss-list .ss-option .ss-search-highlight{background-color:#fffb8c} -------------------------------------------------------------------------------- /inst/htmlwidgets/topogram_select.js: -------------------------------------------------------------------------------- 1 | (()=>{"use strict";var e={25:(e,t,i)=>{i.d(t,{Z:()=>l});var s=i(81),n=i.n(s),a=i(645),o=i.n(a)()(n());o.push([e.id,'.ss-main{position:relative;display:inline-block;user-select:none;color:#666;width:100%}.ss-main .ss-single-selected{display:flex;cursor:pointer;width:100%;height:30px;padding:6px;border:1px solid #dcdee2;border-radius:4px;background-color:#fff;outline:0;box-sizing:border-box;transition:background-color .2s}.ss-main .ss-single-selected.ss-disabled{background-color:#dcdee2;cursor:not-allowed}.ss-main .ss-single-selected.ss-open-above{border-top-left-radius:0;border-top-right-radius:0}.ss-main .ss-single-selected.ss-open-below{border-bottom-left-radius:0;border-bottom-right-radius:0}.ss-main .ss-single-selected .placeholder{flex:1 1 100%;text-align:left;width:calc(100% - 30px);line-height:1em;-webkit-user-select:none;-moz-user-select:none;-ms-user-select:none;user-select:none}.ss-main .ss-single-selected .placeholder,.ss-main .ss-single-selected .placeholder *{display:flex;align-items:center;overflow:hidden;text-overflow:ellipsis;white-space:nowrap}.ss-main .ss-single-selected .placeholder *{width:auto}.ss-main .ss-single-selected .placeholder .ss-disabled{color:#dedede}.ss-main .ss-single-selected .ss-deselect{display:flex;align-items:center;justify-content:flex-end;flex:0 1 auto;margin:0 6px;font-weight:700}.ss-main .ss-single-selected .ss-deselect.ss-hide{display:none}.ss-main .ss-single-selected .ss-arrow{display:flex;align-items:center;justify-content:flex-end;flex:0 1 auto;margin:0 6px}.ss-main .ss-single-selected .ss-arrow span{border:solid #666;border-width:0 2px 2px 0;display:inline-block;padding:3px;transition:transform .2s,margin .2s}.ss-main .ss-single-selected .ss-arrow span.arrow-up{transform:rotate(-135deg);margin:3px 0 0}.ss-main .ss-single-selected .ss-arrow span.arrow-down{transform:rotate(45deg);margin:-3px 0 0}.ss-main .ss-multi-selected{display:flex;flex-direction:row;cursor:pointer;min-height:30px;width:100%;padding:0 0 0 3px;border:1px solid #dcdee2;border-radius:4px;background-color:#fff;outline:0;box-sizing:border-box;transition:background-color .2s}.ss-main .ss-multi-selected.ss-disabled{background-color:#dcdee2;cursor:not-allowed}.ss-main .ss-multi-selected.ss-disabled .ss-values .ss-disabled{color:#666}.ss-main .ss-multi-selected.ss-disabled .ss-values .ss-value .ss-value-delete{cursor:not-allowed}.ss-main .ss-multi-selected.ss-open-above{border-top-left-radius:0;border-top-right-radius:0}.ss-main .ss-multi-selected.ss-open-below{border-bottom-left-radius:0;border-bottom-right-radius:0}.ss-main .ss-multi-selected .ss-values{display:flex;flex-wrap:wrap;justify-content:flex-start;flex:1 1 100%;width:calc(100% - 30px)}.ss-main .ss-multi-selected .ss-values .ss-disabled{display:flex;padding:4px 5px;margin:2px 0;line-height:1em;align-items:center;width:100%;color:#dedede;overflow:hidden;text-overflow:ellipsis;white-space:nowrap}@keyframes scaleIn{0%{transform:scale(0);opacity:0}to{transform:scale(1);opacity:1}}@keyframes scaleOut{0%{transform:scale(1);opacity:1}to{transform:scale(0);opacity:0}}.ss-main .ss-multi-selected .ss-values .ss-value{display:flex;user-select:none;align-items:center;font-size:12px;padding:3px 5px;margin:3px 5px 3px 0;color:#fff;background-color:#5897fb;border-radius:4px;animation-name:scaleIn;animation-duration:.2s;animation-timing-function:ease-out;animation-fill-mode:both}.ss-main .ss-multi-selected .ss-values .ss-value.ss-out{animation-name:scaleOut;animation-duration:.2s;animation-timing-function:ease-out}.ss-main .ss-multi-selected .ss-values .ss-value .ss-value-delete{margin:0 0 0 5px;cursor:pointer}.ss-main .ss-multi-selected .ss-add{display:flex;flex:0 1 3px;margin:9px 12px 0 5px}.ss-main .ss-multi-selected .ss-add .ss-plus{display:flex;justify-content:center;align-items:center;background:#666;position:relative;height:10px;width:2px;transition:transform .2s}.ss-main .ss-multi-selected .ss-add .ss-plus:after{background:#666;content:"";position:absolute;height:2px;width:10px;left:-4px;top:4px}.ss-main .ss-multi-selected .ss-add .ss-plus.ss-cross{transform:rotate(45deg)}.ss-content{position:absolute;width:100%;margin:-1px 0 0;box-sizing:border-box;border:1px solid #dcdee2;z-index:1010;background-color:#fff;transform-origin:center top;transition:transform .2s,opacity .2s;opacity:0;transform:scaleY(0)}.ss-content.ss-open{display:block;opacity:1;transform:scaleY(1)}.ss-content .ss-search{display:flex;flex-direction:row;padding:8px 8px 6px}.ss-content .ss-search.ss-hide,.ss-content .ss-search.ss-hide input{height:0;opacity:0;padding:0;margin:0}.ss-content .ss-search input{display:inline-flex;font-size:inherit;line-height:inherit;flex:1 1 auto;width:100%;min-width:0;height:30px;padding:6px 8px;margin:0;border:1px solid #dcdee2;border-radius:4px;background-color:#fff;outline:0;text-align:left;box-sizing:border-box;-webkit-box-sizing:border-box;-webkit-appearance:textfield}.ss-content .ss-search input::placeholder{color:#8a8a8a;vertical-align:middle}.ss-content .ss-search input:focus{box-shadow:0 0 5px #5897fb}.ss-content .ss-search .ss-addable{display:inline-flex;justify-content:center;align-items:center;cursor:pointer;font-size:22px;font-weight:700;flex:0 0 30px;height:30px;margin:0 0 0 8px;border:1px solid #dcdee2;border-radius:4px;box-sizing:border-box}.ss-content .ss-addable{padding-top:0}.ss-content .ss-list{max-height:200px;overflow-x:hidden;overflow-y:auto;text-align:left}.ss-content .ss-list .ss-optgroup .ss-optgroup-label{padding:6px 10px;font-weight:700}.ss-content .ss-list .ss-optgroup .ss-option{padding:6px 6px 6px 25px}.ss-content .ss-list .ss-optgroup-label-selectable{cursor:pointer}.ss-content .ss-list .ss-optgroup-label-selectable:hover{color:#fff;background-color:#5897fb}.ss-content .ss-list .ss-option{padding:6px 10px;cursor:pointer;user-select:none}.ss-content .ss-list .ss-option *{display:inline-block}.ss-content .ss-list .ss-option.ss-highlighted,.ss-content .ss-list .ss-option:hover{color:#fff;background-color:#5897fb}.ss-content .ss-list .ss-option.ss-disabled{cursor:not-allowed;color:#dedede;background-color:#fff}.ss-content .ss-list .ss-option:not(.ss-disabled).ss-option-selected{color:#666;background-color:rgba(88,151,251,.1)}.ss-content .ss-list .ss-option.ss-hide{display:none}.ss-content .ss-list .ss-option .ss-search-highlight{background-color:#fffb8c}',""]);const l=o},645:e=>{e.exports=function(e){var t=[];return t.toString=function(){return this.map((function(t){var i="",s=void 0!==t[5];return t[4]&&(i+="@supports (".concat(t[4],") {")),t[2]&&(i+="@media ".concat(t[2]," {")),s&&(i+="@layer".concat(t[5].length>0?" ".concat(t[5]):""," {")),i+=e(t),s&&(i+="}"),t[2]&&(i+="}"),t[4]&&(i+="}"),i})).join("")},t.i=function(e,i,s,n,a){"string"==typeof e&&(e=[[null,e,void 0]]);var o={};if(s)for(var l=0;l0?" ".concat(d[5]):""," {").concat(d[1],"}")),d[5]=a),i&&(d[2]?(d[1]="@media ".concat(d[2]," {").concat(d[1],"}"),d[2]=i):d[2]=i),n&&(d[4]?(d[1]="@supports (".concat(d[4],") {").concat(d[1],"}"),d[4]=n):d[4]="".concat(n)),t.push(d))}},t}},81:e=>{e.exports=function(e){return e[1]}},379:e=>{var t=[];function i(e){for(var i=-1,s=0;s{var t={};e.exports=function(e,i){var s=function(e){if(void 0===t[e]){var i=document.querySelector(e);if(window.HTMLIFrameElement&&i instanceof window.HTMLIFrameElement)try{i=i.contentDocument.head}catch(e){i=null}t[e]=i}return t[e]}(e);if(!s)throw new Error("Couldn't find a style target. This probably means that the value for the 'insert' parameter is invalid.");s.appendChild(i)}},216:e=>{e.exports=function(e){var t=document.createElement("style");return e.setAttributes(t,e.attributes),e.insert(t,e.options),t}},565:(e,t,i)=>{e.exports=function(e){var t=i.nc;t&&e.setAttribute("nonce",t)}},795:e=>{e.exports=function(e){var t=e.insertStyleElement(e);return{update:function(i){!function(e,t,i){var s="";i.supports&&(s+="@supports (".concat(i.supports,") {")),i.media&&(s+="@media ".concat(i.media," {"));var n=void 0!==i.layer;n&&(s+="@layer".concat(i.layer.length>0?" ".concat(i.layer):""," {")),s+=i.css,n&&(s+="}"),i.media&&(s+="}"),i.supports&&(s+="}");var a=i.sourceMap;a&&"undefined"!=typeof btoa&&(s+="\n/*# sourceMappingURL=data:application/json;base64,".concat(btoa(unescape(encodeURIComponent(JSON.stringify(a))))," */")),t.styleTagTransform(s,e,t.options)}(t,e,i)},remove:function(){!function(e){if(null===e.parentNode)return!1;e.parentNode.removeChild(e)}(t)}}}},589:e=>{e.exports=function(e,t){if(t.styleSheet)t.styleSheet.cssText=e;else{for(;t.firstChild;)t.removeChild(t.firstChild);t.appendChild(document.createTextNode(e))}}}},t={};function i(s){var n=t[s];if(void 0!==n)return n.exports;var a=t[s]={id:s,exports:{}};return e[s](a,a.exports,i),a.exports}i.n=e=>{var t=e&&e.__esModule?()=>e.default:()=>e;return i.d(t,{a:t}),t},i.d=(e,t)=>{for(var s in t)i.o(t,s)&&!i.o(e,s)&&Object.defineProperty(e,s,{enumerable:!0,get:t[s]})},i.o=(e,t)=>Object.prototype.hasOwnProperty.call(e,t),(()=>{HTMLWidgets;var e,t,s={};e=window,t=function(){return i={},e.m=t=[function(e,t,i){function s(e,t){t=t||{bubbles:!1,cancelable:!1,detail:void 0};var i=document.createEvent("CustomEvent");return i.initCustomEvent(e,t.bubbles,t.cancelable,t.detail),i}var n;t.__esModule=!0,t.hasClassInTree=function(e,t){function i(e,t){return t&&e&&e.classList&&e.classList.contains(t)?e:null}return i(e,t)||function e(t,s){return t&&t!==document?i(t,s)?t:e(t.parentNode,s):null}(e,t)},t.ensureElementInView=function(e,t){var i=e.scrollTop+e.offsetTop,s=i+e.clientHeight,n=t.offsetTop,a=n+t.clientHeight;n=window.innerHeight?"above":i?t:"below"},t.debounce=function(e,t,i){var s;return void 0===t&&(t=100),void 0===i&&(i=!1),function(){for(var n=[],a=0;a[^<>]*'+l+"")},t.kebabCase=function(e){var t=e.replace(/[A-Z\u00C0-\u00D6\u00D8-\u00DE]/g,(function(e){return"-"+e.toLowerCase()}));return e[0]===e[0].toUpperCase()?t.substring(1):t},"function"!=typeof(n=window).CustomEvent&&(s.prototype=n.Event.prototype,n.CustomEvent=s)},function(e,t,i){t.__esModule=!0;var s=(n.prototype.newOption=function(e){return{id:e.id?e.id:String(Math.floor(1e8*Math.random())),value:e.value?e.value:"",text:e.text?e.text:"",innerHTML:e.innerHTML?e.innerHTML:"",selected:!!e.selected&&e.selected,display:void 0===e.display||e.display,disabled:!!e.disabled&&e.disabled,placeholder:!!e.placeholder&&e.placeholder,class:e.class?e.class:void 0,data:e.data?e.data:{},mandatory:!!e.mandatory&&e.mandatory}},n.prototype.add=function(e){this.data.push({id:String(Math.floor(1e8*Math.random())),value:e.value,text:e.text,innerHTML:"",selected:!1,display:!0,disabled:!1,placeholder:!1,class:void 0,mandatory:e.mandatory,data:{}})},n.prototype.parseSelectData=function(){this.data=[];for(var e=0,t=this.main.select.element.childNodes;e