countries

DESCRIPTION

@@ -29,5 +29,7 @@ Imports:
   base64enc,
   utils,
   R.utils
-Suggests: jsonlite
+Suggests: jsonlite, magrittr
 RoxygenNote: 7.1.1
+Depends: 
+    R (>= 2.10)

R/Countries.R

@@ -0,0 +1,6 @@
+#' Countries
+#' @description Countries data with country code, name, currency code,
+#'   population, capital and continent name.
+#'
+#' @format A dataframe with 250 rows and 6 columns.
+"Countries"

R/jstree.R

@@ -845,6 +845,84 @@ jstree <- function(
 #' if(interactive()){
 #'   shinyApp(ui, server)
 #' }
+#'
+#'
+#' # Filtering ####
+#'
+#' library(jsTreeR)
+#' library(shiny)
+#' library(htmlwidgets)
+#' library(magrittr)
+#'
+#' data("Countries")
+#' rownames(Countries) <- Countries[["countryName"]]
+#' dat <- split(Countries, Countries[["continentName"]])
+#' nodes <- lapply(names(dat), function(continent){
+#'   list(
+#'     text = continent,
+#'     children = lapply(dat[[continent]][["countryName"]], function(cntry){
+#'       list(
+#'         text = cntry,
+#'         data = list(population = Countries[cntry, "population"])
+#'       )
+#'     })
+#'   )
+#' })
+#'
+#' onrender <- c(
+#'   "function(el, x) {",
+#'   "  Shiny.addCustomMessageHandler('hideNodes', function(range) {",
+#'   "    var tree = $.jstree.reference(el.id);",
+#'   "    var json = tree.get_json(null, {flat: true});",
+#'   "    for(var i = 0; i < json.length; i++) {",
+#'   "      var id = json[i].id;",
+#'   "      if(tree.is_leaf(id)) {",
+#'   "        var pop = json[i].data.population;",
+#'   "        if(pop < range[0] || pop > range[1]) {",
+#'   "          tree.hide_node(id);",
+#'   "        } else {",
+#'   "          tree.show_node(id);",
+#'   "        }",
+#'   "      }",
+#'   "    }",
+#'   "  });",
+#'   "}"
+#' )
+#'
+#' ui <- fluidPage(
+#'   tags$h3("Open a node and filter with the slider."),
+#'   br(),
+#'   fluidRow(
+#'     column(
+#'       6,
+#'       jstreeOutput("tree")
+#'     ),
+#'     column(
+#'       6,
+#'       sliderInput(
+#'         "range",
+#'         label = "Population",
+#'         min = 0, max = 100000000, value = c(0, 100000000)
+#'       )
+#'     )
+#'   )
+#' )
+#'
+#' server <- function(input, output, session){
+#'
+#'   output[["tree"]] <- renderJstree({
+#'     jstree(nodes, checkboxes = TRUE) %>% onRender(onrender)
+#'   })
+#'
+#'   observeEvent(input[["range"]], {
+#'     session$sendCustomMessage("hideNodes", input[["range"]])
+#'   })
+#'
+#' }
+#'
+#' if(interactive()){
+#'   shinyApp(ui, server)
+#' }
 jstreeOutput <- function(outputId, width = "100%", height = "auto"){
   htmlwidgets::shinyWidgetOutput(
     outputId, 'jstree', width, height, package = 'jsTreeR'

inst/essais/countries.R

@@ -0,0 +1,77 @@
+# library(jsonlite)
+# dd <- fromJSON("https://gist.githubusercontent.com/tiagodealmeida/0b97ccf117252d742dddf098bc6cc58a/raw/f621703926fc13be4f618fb4a058d0454177cceb/countries.json")
+# Countries <- dd$countries$country
+
+# Filtering ####
+library(jsTreeR)
+library(shiny)
+library(htmlwidgets)
+library(magrittr)
+
+data("Countries")
+rownames(Countries) <- Countries[["countryName"]]
+dat <- split(Countries, Countries[["continentName"]])
+nodes <- lapply(names(dat), function(continent){
+  list(
+    text = continent,
+    children = lapply(dat[[continent]][["countryName"]], function(cntry){
+      list(
+        text = cntry,
+        data = list(population = Countries[cntry, "population"])
+      )
+    })
+  )
+})
+
+onrender <- c(
+  "function(el, x) {",
+  "  Shiny.addCustomMessageHandler('hideNodes', function(range) {",
+  "    var tree = $.jstree.reference(el.id);",
+  "    var json = tree.get_json(null, {flat: true});",
+  "    for(var i = 0; i < json.length; i++) {",
+  "      var id = json[i].id;",
+  "      if(tree.is_leaf(id)) {",
+  "        var pop = json[i].data.population;",
+  "        if(pop < range[0] || pop > range[1]) {",
+  "          tree.hide_node(id);",
+  "        } else {",
+  "          tree.show_node(id);",
+  "        }",
+  "      }",
+  "    }",
+  "  });",
+  "}"
+)
+
+ui <- fluidPage(
+  tags$h3("Open a node and filter with the slider."),
+  br(),
+  fluidRow(
+    column(
+      6,
+      jstreeOutput("tree")
+    ),
+    column(
+      6,
+      sliderInput(
+        "range",
+        label = "Population",
+        min = 0, max = 100000000, value = c(0, 100000000)
+      )
+    )
+  )
+)
+
+server <- function(input, output, session){
+
+  output[["tree"]] <- renderJstree({
+    jstree(nodes, checkboxes = TRUE) %>% onRender(onrender)
+  })
+
+  observeEvent(input[["range"]], {
+    session$sendCustomMessage("hideNodes", input[["range"]])
+  })
+
+}
+
+shinyApp(ui, server)

inst/essais/essai_flexdashboard01.Rmd

@@ -0,0 +1,80 @@
+---
+title: "Untitled"
+output: 
+  flexdashboard::flex_dashboard:
+    orientation: columns
+    vertical_layout: fill
+runtime: shiny
+---
+
+```{r setup, include=FALSE}
+library(flexdashboard)
+library(shiny)
+library(jsTreeR)
+```
+
+```{r}
+nodes <- list(
+  list(
+    text = "RootA",
+    data = list(value = 999),
+    icon = "far fa-moon red",
+    children = list(
+      list(
+        text = "ChildA1",
+        icon = "fa fa-leaf green"
+      ),
+      list(
+        text = "ChildA2",
+        icon = "fa fa-leaf green"
+      )
+    )
+  ),
+  list(
+    text = "RootB",
+    icon = "far fa-moon red",
+    children = list(
+      list(
+        text = "ChildB1",
+        icon = "fa fa-leaf green"
+      ),
+      list(
+        text = "ChildB2",
+        icon = "fa fa-leaf green"
+      )
+    )
+  )
+)
+output[["jstree"]] <- renderJstree({
+  jstree(nodes, dragAndDrop = TRUE, checkboxes = TRUE, theme = "proton")
+})
+output[["treeSelected"]] <- renderPrint({
+  input[["jstree_selected"]]
+})
+```
+
+
+Column {data-width=400}
+-----------------------------------------------------------------------
+
+### Checkbox tree
+
+```{r}
+jstreeOutput("jstree")
+```
+
+Column {data-width=400}
+-----------------------------------------------------------------------
+
+### Selected nodes
+
+```{r}
+verbatimTextOutput("treeSelected")
+```
+
+### Chart C
+
+```{r}
+
+```
+

inst/essais/essai_shiny_filter_slider_01.R

@@ -0,0 +1,97 @@
+library(jsTreeR)
+library(shiny)
+library(htmlwidgets)
+library(magrittr)
+
+onrender <- c(
+  "function(el, x) {",
+  "  Shiny.addCustomMessageHandler('hideNodes', function(threshold) {",
+  "    var tree = $.jstree.reference(el.id);",
+  "    var json = tree.get_json(null, {flat: true});",
+  "    for(var i = 0; i < json.length; i++) {",
+  "      if(tree.is_leaf(json[i].id) && json[i].text <= threshold) {",
+  "        tree.hide_node(json[i].id);",
+  "      } else {",
+  "        tree.show_node(json[i].id);",
+  "      }",
+  "    }",
+  "  });",
+  "}"
+)
+
+nodes <- list(
+  list(
+    text = "1-3a",
+    children = list(
+      list(
+        text = "1"
+      ),
+      list(
+        text = "2"
+      ),
+      list(
+        text = "3"
+      )
+    )
+  ),
+  list(
+    text = "1-3b",
+    children = list(
+      list(
+        text = "1"
+      ),
+      list(
+        text = "2"
+      ),
+      list(
+        text = "3"
+      )
+    )
+  ),
+  list(
+    text = "4-6",
+    children = list(
+      list(
+        text = "4"
+      ),
+      list(
+        text = "5"
+      ),
+      list(
+        text = "6"
+      )
+    )
+  )
+)
+
+ui <- fluidPage(
+  br(),
+  fluidRow(
+    column(
+      3,
+      jstreeOutput("tree")
+    ),
+    column(
+      9,
+      sliderInput(
+        "threshold",
+        label = "Threshold",
+        min = 0, max = 10, value = 0, step = 1
+      )
+    )
+  )
+)
+
+server <- function(input, output, session){
+
+  output[["tree"]] <- renderJstree({
+    jstree(nodes, checkboxes = TRUE) %>% onRender(onrender)
+  })
+
+  observeEvent(input[["threshold"]], {
+    session$sendCustomMessage("hideNodes", input[["threshold"]])
+  })
+
+}
+
+shinyApp(ui, server)