diff --git a/DESCRIPTION b/DESCRIPTION index 3578e28..fb0f017 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -29,5 +29,7 @@ Imports: base64enc, utils, R.utils -Suggests: jsonlite +Suggests: jsonlite, magrittr RoxygenNote: 7.1.1 +Depends: + R (>= 2.10) diff --git a/R/Countries.R b/R/Countries.R new file mode 100644 index 0000000..4b92619 --- /dev/null +++ b/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" diff --git a/R/jstree.R b/R/jstree.R index a0ceefa..10dfe89 100644 --- a/R/jstree.R +++ b/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' diff --git a/data/Countries.rda b/data/Countries.rda new file mode 100644 index 0000000..7720464 Binary files /dev/null and b/data/Countries.rda differ diff --git a/inst/essais/countries.R b/inst/essais/countries.R new file mode 100644 index 0000000..fa9f74a --- /dev/null +++ b/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) diff --git a/inst/essais/essai_flexdashboard01.Rmd b/inst/essais/essai_flexdashboard01.Rmd new file mode 100644 index 0000000..86b5c88 --- /dev/null +++ b/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} + +``` + diff --git a/inst/essais/essai_shiny_filter_slider_01.R b/inst/essais/essai_shiny_filter_slider_01.R new file mode 100644 index 0000000..05d15dd --- /dev/null +++ b/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) diff --git a/inst/essais/essai_shiny_fullState_01.R b/inst/essais/essai_shiny_fullState_01.R new file mode 100644 index 0000000..1f543f2 --- /dev/null +++ b/inst/essais/essai_shiny_fullState_01.R @@ -0,0 +1,92 @@ +library(jsTreeR) +library(shiny) +library(htmlwidgets) + +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(json[i].text <= 1) {", + " 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, + verbatimTextOutput("state") + ) + ) +) + +server <- function(input, output){ + + output[["tree"]] <- renderJstree({ + jstree(nodes) %>% onRender(onrender) + }) + + output[["state"]] <- renderPrint({ + input[["tree_full"]] + }) + +} + +shinyApp(ui, server) diff --git a/inst/essais/nodesFromNestedList.R b/inst/essais/nodesFromNestedList.R new file mode 100644 index 0000000..ec93118 --- /dev/null +++ b/inst/essais/nodesFromNestedList.R @@ -0,0 +1,25 @@ +L <- list( + Europe = list( + "France", "Germany" + ), + America = list( + NorthAmerica = list( + "Canada", "USA" + ), + SouthAmerica = list( + "Mexic", "Brazil" + ) + ) +) + +f <- function(L){ + if(length(names(L))){ + lapply(names(L), function(nm){ + list(text = nm, children = f(L[[nm]])) + }) + }else{ + lapply(L, function(x) list(text = x)) + } +} + +f(L) diff --git a/inst/htmlwidgets/jstree.js b/inst/htmlwidgets/jstree.js index bf4a479..a95d1b4 100644 --- a/inst/htmlwidgets/jstree.js +++ b/inst/htmlwidgets/jstree.js @@ -30,6 +30,10 @@ function setShinyValue(instance) { instance.element.attr("id") + ":jsTreeR.list", getNodesWithChildren(instance.get_json(), ["text","data"]) ); + Shiny.setInputValue( + instance.element.attr("id") + "_full:jsTreeR.list", + instance.get_json() + ); } function setShinyValueSelectedNodes(instance) { diff --git a/man/Countries.Rd b/man/Countries.Rd new file mode 100644 index 0000000..e8c7b89 --- /dev/null +++ b/man/Countries.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Countries.R +\docType{data} +\name{Countries} +\alias{Countries} +\title{Countries} +\format{ +A dataframe with 250 rows and 6 columns. +} +\usage{ +Countries +} +\description{ +Countries data with country code, name, currency code, + population, capital and continent name. +} +\keyword{datasets} diff --git a/man/jstree-shiny.Rd b/man/jstree-shiny.Rd index 3e3238a..6f411fa 100644 --- a/man/jstree-shiny.Rd +++ b/man/jstree-shiny.Rd @@ -477,6 +477,84 @@ server <- function(input, output){ renderJstree(jstree(nodes, grid = grid, types = types)) } +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) }