From 9a79ecd7d2652954d61c4811de5b6d89c635b951 Mon Sep 17 00:00:00 2001 From: stla Date: Sat, 16 Jan 2021 09:45:55 +0100 Subject: [PATCH] countries --- DESCRIPTION | 4 +- R/Countries.R | 6 ++ R/jstree.R | 78 +++++++++++++++++ data/Countries.rda | Bin 0 -> 5606 bytes inst/essais/countries.R | 77 ++++++++++++++++ inst/essais/essai_flexdashboard01.Rmd | 80 +++++++++++++++++ inst/essais/essai_shiny_filter_slider_01.R | 97 +++++++++++++++++++++ inst/essais/essai_shiny_fullState_01.R | 92 +++++++++++++++++++ inst/essais/nodesFromNestedList.R | 25 ++++++ inst/htmlwidgets/jstree.js | 4 + man/Countries.Rd | 17 ++++ man/jstree-shiny.Rd | 78 +++++++++++++++++ 12 files changed, 557 insertions(+), 1 deletion(-) create mode 100644 R/Countries.R create mode 100644 data/Countries.rda create mode 100644 inst/essais/countries.R create mode 100644 inst/essais/essai_flexdashboard01.Rmd create mode 100644 inst/essais/essai_shiny_filter_slider_01.R create mode 100644 inst/essais/essai_shiny_fullState_01.R create mode 100644 inst/essais/nodesFromNestedList.R create mode 100644 man/Countries.Rd 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 0000000000000000000000000000000000000000..77204648377d11422164cc9b7e43ed91b862a020 GIT binary patch literal 5606 zcmV}@*d+A=K;HxjM zYjSwI2Bttw0j7Wnpb0Zcr1GfrdXb)Bpfz001>Sf)If{0%8R)qscZ<0Av6F z001_ofB+audXRxkr|3;br7{|1G-;4D^#Eu902+FRO*9P+001IVXqqXSo75EA8c#xc zCYTcw0(zL5G7UX6k4+JQ8VxiW7@Ha&okI$tP|Sd;?rfkcx4}^~ZlVAw;)tOP-Jgzj zc$W$ohuQz;ARuIbs@xa$?4(5%YFV}9@qP#C=&f$@N>dt+j1^aP5mndCx5GTx^38pI zk4rLppD$nL`TIJ*S8HRpv)uc5ds}*&7-5DRIsMHD{MK1zmVEYo7FqZ#jAI|3F^p@% z5W>3ezImlwSqM>e(VA(dZP;Hu^iehP-}GZWb>oHhJ??8^3EJByl6SeRp)iCQD<247 zZMVMHLKfpI4spw{0Nh1Arc-vIA-P8+_1={acXF{)wy=4TD(_n`X zMinxmOvoa#ksb^%BP3-clRYa+whmGuP&6|=n$ljca`>TMYGK(M?<=MVYV2KRjxAO! zn^wuKwam8+lRgA3sqVv@Hj5ejCzlrlt2A&$nk%n+q`A!AuaY z&zB*$UhSKCLpgtp?b2PT9A;X|v%xKmEY#1Ah=RbNio_}^2!Lxi#VG1omEE?70tHc2 zRajwC5d_eh2!t~~;kY;NBaO0QlVH{4v~|_1WG&IC)ksMxwEDE=THsxV!PVKthZV=J zU_(bLjzuFYl6wn{;nx-g$*CL+biuo3TE3@#S!h+MNdqIb zk(Ma1O~M+LRe5$QWS(iL3N}==+jH@ zE&G#ej}z&AnO?J#vkiJ1#+|8vy%2frzmk9o3Q&D;qAElc4cs9BC=!7cRo2~60RYp8 ziV_N-NUE{|NT?)=AV{MiNT{LLhzcR~#zj?RQAq(okQoJ%KqNttBtVc>L{qcu2wPBfi#c=TWt_tr#d6wZywD3=I{}4B9}P9G)qW zVP{C3EK}=)X;hLc^T91r(t-P<;u8<6q7m=(uYKrVhV=Rna1uaPzIKC4RXO*j$I~i+ znKEyLv{eATg7+3B76CxL3SE{rUm`MPm2pysVG&le(KNwQBEYAIhe$c8M>!*CMGH|$ zRZ2|84v5rDoT(}lQ%s5`Fz6@~*xhXO5aBa~{)dtvhn?RpgW|;&ce@op5lMz&6=QTfqcZb9sn;Y&{Y_ zCCJwAkb50kVNzl8gFCVD1G`8G0~H{My&iNVCewCFt&eNlPa4>7LIawa2wjB`4<@FT z$i3O`6{*;e^675d0#lei+v!9d)#|FkJjN4+k z7Gb7MsfKoVgFHIpWUFHg<7$>DyE??c;t?>;t{D@=vk*EF#s=Qw1e6G^(JQ$KOlKKs z3pL%~_BTts5EPQhnqyf0+3|SZJEC zc|?V6^pK7xD;la=BEYB%<&v>7NZN~Msi<<2DnuM%95hgdPM0|Y5~WL3vNscDq;v)> zGc{ofaIb=QqOD#qpk8Q?G{+euMGBLsR@QQ5Dv}P6t_0=5o?LO6Lwu3jl#NytO)bXO zxHbjk2;@?+Kxje)-e{QC)fCDjV)#Ii^u{rVI#6#*TG6or*wpA8i0t)DFIdVGnLxx^1S%M_ z*$~rePD-2-@hrD=3N9UzTnO6Ui)UOcqnHXjqz=MN z0t^Fk1{NgLN~X|Ns<8u-Q+qoS%qggqhEWReDz@_aJua7_>T~)&j~5q5*Qepd%IVA; z(y^V!f(?$w0d2OGYzT+|P6@x&CegqYD*+*<+dvm?msjq)PHpgqyTaTU@yi5ofq`Jel0hV$6xF9T)Y~&09hgKA$n8yJy~L^hEc$PI zB|pg3HHC?p{%7&}E#=D%-9G+V5a<9iK>|S#A|hd#5fBBIMFA4J23)?aImjAvAsT&O zcuOi4GH}f*l&CJewB`NUU!LYAPWoBk{|0Yx_c7*^d8mw&_=&%XiyhV7O!`~UoUte| zL|B>_>YRn466bPSvy_Yk0nW^@`3v!=UxESxD#LYF+g|=0go6_{5I$WDIi@vBH%gt(#9~BE zA?4+VEDc_Gbs0H-l`WS%?9Y9XAJAQ+p*B3kX>;CV^boYlOlz*mS<;SRk6r5XP;wF8>PzG z%h|EXkrvoZ661UT4<2c27s3Q4`knl+hgN@3wLnCWaqg}-=>5_ zf~nHdwUq$O0=pZ(E~+7ZoiuZ`3q52q1mO(ozil_!-;Ug|%YTNoYp5W5Gt+AtSxqw{ zs>YdSa1Vv;{(ozOLbM}ud)fU^jsM55tg~z*)0t0?maW8?k z%q#HD?$`No<++KLS8)J28fe-mmU;5Q2ndB`Wy{?TkB5F@`o`ZjB_Loq#;S5cAUaInrNLy+RlPN2~9Npchzkvn)?$fOp1fD{D+}rL#D~< zl%r{?t6HtET`$MQp7O?7ecnue&NR%3mqD!p%tdOdv8~fdhdGsVnT2>bdIu|=J(fi5 zP`8cz&O&x&?t=DhFAXFX3H%9aD_f_G0Rrs!a@NBq@%_cmDMWd-UP+<`iRajLR zMNvoR>wh@)`IVgV-hERavrJ*y6V)jBMX(3`)6)i=7U0lkgBk-FyS&Nh$T{Krj{Ab z;8U6+U`bGS=Pt-ReGQiS0nT_)5s=v|Basvt_pV~-Rf1%@>`2zWZ*`CJ9?p>;7W;`e z_{l1^1k@mSKSz0g?!t!mdEL^FKf8zL(+i`0+70z)rip6jDT$^$9=Vj60>7%gg}-;^ zd)_D9BCZuyNacm^s~)_w!-Hi%6(mcl_stPs@pxD)wQ1kWeknFCCWaY>lyT@CKoN?9 zON{eO%KJ|`pL{tHGYJ;)fV_~9WHhqs>e>ONmvh9=xzQHt(0AL6EL{vUx)#f;=p85N zCP;qTVV34#6I_r-n;STe3zd(7Mi>jH2rFrg71sg+Z4$oSnIAe*8N+nXp*E$9Hp>~^ z&SBs9F`!y0n?J$8WZu(BGPnv&ZX7#>g5CT4Di$T2D)8&7Wu*0YYJ~WLp?mLB)z#mC zC((y{*NIrzq2=-INvmrS58&AfJFwbiU5@V)Q?^J~;gD+`-LN@m`op7@1(PQd&Vyvn1dH709O64oL z%buB2L!04hN9~=7^Vi^+b;;F_$UUZrseAYBDMc-4L3|xwwr%Aa6LIdM+vcksTW86_ z=JNSaF7^0;_s`LXj)`9)ya0qYI8H#`R=xrkf^0j-o$QU=4&(DDwr+6~DrXp> zYNx#{h{&K}2#H_>U=}fvlSc=GdwqG`8}Qvb+9t(2?pe0cZe<08;c%zpwiOC)??hxy z?qoI5lPmq)`4@u|s=`ln0Ur{a*Q% zu}JZwUv^bHz5=A9GQsnfSW~Um4+X8NP=HAkf>D{}$!M92MFfhy!5w+h*)mw60Ud{Al6*5bn-H%y6?vV9KS-ikAdxu|=aGUzK{GBs zQO907UR{!>_P&FL_yNcioHlC3;SMos;4Ct_^vw_g+Nhe;^a%fxrgI zcWU67Jz8km>$_#5_}X>r=UYx%5qBiN_!eWs$=-wwWU?G8_cETqKy>&`=SB#h7@1*Fk1N^G#l5wA4eytE1H;@EW`At{t^gKJ926hRaRX;C4}rKJr1NXsj* zYF71(@!0xkM&nA36VABMoaWT6&eG6~ED8#!BLc9jA}}I~0>x%wP+(PI7-3jpf_yWJ zNm%IaU`pQg2Uz7HfX0a}WN9>Fy4!z)>b_~q@gg+$`&F_?m5tJKY^W9yM2%@lWrJnt zeQ)b5tRGU`I%Bx^kzvIh=xD{*rojCOfXcbJg#rKZI<1KdN?sC zdZ?zC)|vRNkf5>(W4`+U)TIEKaqrPDoC~q!zal!o10WV)kOw|K7`GrSR-PCR65bVD zu{};xLfWY?(D`MWL}2RXhru%-NHk!Uct!w=bskzAq*B(w%1Me|Wq!--HY<^I z3JNHz5F!j9puz~Jgc;ph?7vp@+S1XSL)<7rj8Q416ESvak)}ptTD|aC3p@f%)09Zo zauK-+?7j4^5lT<|+m)Y{wU;l;{jjl%c_rUyzUM90Y)Bu(O)a4DUv2bvfiTHwNb&5S)6zueVbrP+i12tH`Aey9xJk2x|7N=0Dt(qk}1N3fLM7g&@dlt AO#lD@ literal 0 HcmV?d00001 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) }