r - Nested Modules Shiny and navigation between tabs -
i'm trying develop app using modules display ui content of different tabs. in app want able create new tabpanels dynamically. used rohde's solution found here. works can't figure out why navigation in-between tabs not work, following error message: "warning: error in if: argument of length zero" , "65: observeeventhandler [committedcustomers.r#20]".
i have problem, i'm using nested modules display different ui content. when display iterationtabui3 (on of module) display sidebarpanel , retain same navlistpanel on left, in code disappears.
here code , modules used:
ui.r:
library(shiny) library(shinydashboard) library(trafficmod) library(plyr) source("iterationtabmodule.r") source("committedcustomers.r") source("iterationtabmodule2.r") source("iterationtabmodule3.r") dashboardpage( dashboardheader(title = "shiny_app"), dashboardsidebar( sidebarmenu(id = "tabs", menuitem("tab1", tabname = "tab1", icon = icon("th")), menuitem("tab2", tabname = "tab2", icon = icon("ravelry")), menuitem("tab3", tabname = "tab3", icon = icon("television")) ) ), dashboardbody( ## add new iteration tags$head(tags$script(html(" /* in coherence original shiny way, tab names created random numbers. avoid duplicate ids, collect generated ids. */ var hrefcollection = []; shiny.addcustommessagehandler('addtabtotabset', function(message){ var hrefcodes = []; /* getting right tabsetpanel */ var tabsettarget = document.getelementbyid(message.tabsetname); /* iterating through panel elements */ for(var = 0; < message.titles.length; i++){ /* creating 6-digit tab id , check, whether assigned. */ { hrefcodes[i] = math.floor(math.random()*100000); } while(hrefcollection.indexof(hrefcodes[i]) != -1); hrefcollection = hrefcollection.concat(hrefcodes[i]); /* creating node in navigation bar */ var navnode = document.createelement('li'); var linknode = document.createelement('a'); linknode.appendchild(document.createtextnode(message.titles[i])); linknode.setattribute('data-toggle', 'tab'); linknode.setattribute('data-value', message.titles[i]); linknode.setattribute('href', '#tab-' + hrefcodes[i]); navnode.appendchild(linknode); tabsettarget.appendchild(navnode); }; /* move tabs content stored. using timeout, because can take 20-50 millis until elements created. */ settimeout(function(){ var creationpool = document.getelementbyid('creationpool').childnodes; var tabcontainertarget = document.getelementsbyclassname('tab-content')[0]; /* again iterate through panels. */ for(var = 0; < creationpool.length; i++){ var tabcontent = creationpool[i]; tabcontent.setattribute('id', 'tab-' + hrefcodes[i]); tabcontainertarget.appendchild(tabcontent); }; }, 100); }); "))), # important! : 'freshly baked' tabs first enter here. uioutput("creationpool", style = "display: none;"), # end important) tabitems( tabitem(tabname = "tab1", navlistpanel(selected = "tabpanel1", id = "iterations", tabpanel("tabpanel1", committedcustomersui("first") ), tabpanel("add new iteration", iterationtabui("one") ), widths = c(3,9) ) ), tabitem(tabname = "tab2", actionbutton('chosen', 'done')), tabitem(tabname = "tab3") ) )) server.r:
library(shiny) library(shinydashboard) library(shinyjs) library(trafficmod) source("iterationtabmodule.r") source("committedcustomers.r") source("iterationtabmodule2.r") source("iterationtabmodule3.r") function(input, output, session) { ## sidebar menu output$tab1 <- rendermenu({ sidebarmenu( menuitem("tab1", tabname = "tab4", icon = icon("th")), menuitem("tab2", tabname = "tab5", icon = icon("ravelry")), menuitem("tab3", tabname = "tab6", icon = icon("television")) ) }) tabnav <- callmodule(iterationtab, "one", iterations, addtabtotabset, tabnav) tabnav <- callmodule(committedcustomers, "first", iterations, tabnav) ## tabnav tabnav <- reactiveval() iterations <- reactive({ input$iterations}) observe({ tabnav(input$iterations) }) observe({ tabnav(input$tabs) }) observeevent(tabnav(), { updatetabitems(session, "tabs", tabnav()) }) observeevent(tabnav(), { updatetabitems(session, "iterations", tabnav()) }) observeevent(input$action1, { updatetabitems(session, "tabs", "tab2") }) observeevent(input$chosen, { updatetabitems(session, "tabs", "tab3") }) ## add new iteration # important! : creationpool should hidden avoid elements flashing before moved. # hidden elements ignored shiny, unless option below set. output$creationpool <- renderui({}) outputoptions(output, "creationpool", suspendwhenhidden = false) # end important # important! : make-easy wrapper adding new tabpanels. addtabtotabset <- function(panels, tabsetname){ titles <- lapply(panels, function(panel){return(panel$attribs$title)}) panels <- lapply(panels, function(panel){panel$attribs$title <- null; return(panel)}) output$creationpool <- renderui({panels}) session$sendcustommessage(type = "addtabtotabset", message = list(titles = titles, tabsetname = tabsetname)) } } module1:
library(shiny) library(shinydashboard) committedcustomersui <- function(id){ ns <- ns(id) taglist( actionbutton(ns("action1"), label = "new version"), actionbutton(ns('action'), 'done') ) } committedcustomers <- function(input, output, session, iterations, tabnav){ ## tabnavigation tabnav <- reactiveval() observeevent(input$action , { if (iterations() == "tabpanel1") { tabnav("tab2") } else{ tabnav("tab2") } }) observeevent(input$action1 , { if (iterations() == "tabpanel1"){ tabnav("add new iteration") } else{ tabnav("add new iteration") } }) return(tabnav) } module2:
library(shiny) library(shinydashboard) iterationtabui <- function(tabid){ ns <- ns(tabid) taglist( fluidrow(column(12, sidebarlayout( sidebarpanel( textinput(ns("iteration_name"), label = "", placeholder = "enter iteration name", width = "200px"), actionbutton(ns("action3"), 'add new iteration'), actionbutton(ns("action2"), 'done'), width = 7 ), mainpanel() ), offset = "50px" ) ) )} iterationtab <- function(input, output, session, iterations, addtabtotabset, tabnav){ observeevent(input$action3, { newtabpanels <- taglist( tabpanel(input$iteration_name, actionbutton("test", label = "test"), iterationtabui3("new") ) ) addtabtotabset(newtabpanels, "iterations") }) tabnav <- callmodule(iterationtab3, "new", iterations, addtabtotabset, tabnav) tabnav <- reactiveval() ## tabnav observeevent(input$action2 , { if (iterations() == "add new iteration") { tabnav("satellite") } else{ tabnav("satellite") } }) } module3:
library(shiny) library(shinydashboard) iterationtabui2 <- function(tabid){ ns <- ns(tabid) taglist(tabitems( tabitem(tabname = "tab1", navlistpanel(selected = "tabpanel1", id = ns("iterations"), tabpanel("tabpanel1", committedcustomersui(ns("first")) ), tabpanel("add new iteration", iterationtabui(ns("one")) ), widths = c(3,9) ) ), tabitem(tabname = "tab2", actionbutton(ns('chosen'), 'done')), tabitem(tabname = "tab3") ) ) } iterationtab2 <- function(input, output, session, iterations, addtabtotabset, tabnav){ tabnav <- callmodule(committedcustomers, "first", iterations, tabnav) tabnav <- callmodule(iterationtab, "one", iterations, addtabtotabset, tabnav) ## tabnav observeevent(input$traffic_proffile_generated, { updatetabitems(session, "tabs", "tab2") }) observeevent(input$new_traffic_proffile_generated, { updatetabitems(session, "tabs", "tab2") }) observeevent(input$chosen, { updatetabitems(session, "tabs", "tab3") }) observeevent(input$new_version, { updatetabitems(session, "iterations", "add new iteration") }) } module4:
library(shiny) library(shinydashboard) iterationtabui3 <- function(tabid){ ns <- ns(tabid) taglist( fluidrow(column(12, sidebarlayout( sidebarpanel( actionbutton(ns("action4"), 'done'), width = 7 ), mainpanel() ), offset = "50px" ) ) )} iterationtab3 <- function(input, output, session, iterations, addtabtotabset, tabnav){ ## tabnav observeevent(input$action4 , { if (iterations() == "add new iteration") { tabnav("satellite") } else{ tabnav("satellite") } }) }
Comments
Post a Comment