r - control order of updates in shiny -
here mwe:
library(shiny) runapp(shinyapp( ui = pagewithsidebar( fluidrow( column(3, wellpanel( numericinput("numfields", "select number of fields", 2, min = 1), br(), uioutput("fields"), br(), actionbutton("gobutton", "go!") )), column(3, wellpanel( uioutput("morefields") )), column(3, wellpanel( numericinput("numfields2", "select number of fields 2", 2, min = 1), br(), actionbutton("gobutton2", "go2!") )) ), server = function(input, output, session){ output$fields <- renderui({ numfields <- as.integer(input$numfields) lapply(1:numfields, function(i) { textinput(paste0("field", i), paste0("type in field ", i)) }) }) output$morefields <- renderui({ if (input$gobutton == 0) return(null) isolate({ numfields <- as.integer(input$numfields) lapply(1:numfields, function(i) { checkboxinput(paste0("checkbox", i), paste0("checkbox field ", input[[paste0("field", i)]])) }) }) }) observeevent(input$gobutton2, { numfields2 <- as.integer(input$numfields2) last_field <- paste0("field", numfields2) updatenumericinput(session, "numfields", value = numfields2) updatetextinput(session, "field1", value = "this first field") updatetextinput(session, last_field, value = "this last field") }) }))
now perform following set of actions:
- starting app
- set value of
select number of fields 2
e.g. 3 - press
go2!
button - within left column, number of input fields changed, i'd first , last field filled text, click on
go2!
button again - click on
go!
button ui in middle generated.
my aim avoid steps 4 , 5, same result.
i tried solve issue reactivevalues
-variable , simulated click (as proposed here):
library(shiny) library(shinyjs) jscode <- "shinyjs.click = function(id) { $('#' + id).click(); }" runapp(shinyapp( ui = pagewithsidebar( useshinyjs(), extendshinyjs(text = jscode), fluidrow(...)), server = function(input, output, session){ vals <- reactivevalues(update = 0) output$fields <- renderui({...}) output$morefields <- renderui({...}) observeevent(input$gobutton2, { numfields2 <- as.integer(input$numfields2) updatenumericinput(session, "numfields", value = numfields2) vals$update <- 1 }) observeevent(vals$update, { if (vals$update != 1) return(null) numfields2 <- as.integer(input$numfields2) last_field <- paste0("field", numfields2) updatetextinput(session, "field1", value = "this first field") updatetextinput(session, last_field, value = "this last field") vals$update <- 2 }) observeevent(vals$update, { if (vals$update != 2) return(null) js$click("gobutton") vals$update <- 0 }) }))
now second ui generated, fields remain empty. have click on go2!
3 times before uis updated.
i tried doing following within server
-part:
observeevent(input$gobutton2, { numfields2 <- as.integer(input$numfields2) updatenumericinput(session, "numfields", value = numfields2) }, priority = 2) observeevent(vals$update, { numfields2 <- as.integer(input$numfields2) last_field <- paste0("field", numfields2) updatetextinput(session, "field1", value = "this first field") updatetextinput(session, last_field, value = "this last field") }, priority = 1) observeevent(input$gobutton2, { js$click("gobutton") }, priority = 0)
again course of events bit different, still clicking thrice necessary want.
any suggestions on how achieve final result clicking on go2!
button once?
i able extend idea , make work, though must admit it's not prettiest solution. first problem need make sure text fields generated before make call update values, added
isolate( if (vals$update == 1) { vals$update <- 2 } )
to output$fields
, changed rest of val$update values accordingly. took care of step 4. next problem (to fix step 5) creation of radio buttons called before text inputs updated. don't know how ask shiny let know when update done, instead did modify javascript clicks on button wait 50 milliseconds before clicking.
jscode <- "shinyjs.click = function(id) { settimeout(function(){ $('#' + id).click(); }, 50); }"
again, isn't optimal, it's late , @ least works , it's can use basis. here's full code
library(shiny) library(shinyjs) jscode <- "shinyjs.click = function(id) { settimeout(function(){ $('#' + id).click(); }, 50); }" runapp(shinyapp( ui = fluidpage( useshinyjs(), extendshinyjs(text = jscode), fluidrow( column(3, wellpanel( numericinput("numfields", "select number of fields", 2, min = 1), br(), uioutput("fields"), br(), actionbutton("gobutton", "go!") )), column(3, wellpanel( uioutput("morefields") )), column(3, wellpanel( numericinput("numfields2", "select number of fields 2", 2, min = 1), br(), actionbutton("gobutton2", "go2!") )) )), server = function(input, output, session){ vals <- reactivevalues(update = 0) output$fields <- renderui({ isolate( if (vals$update == 1) { vals$update <- 2 } ) numfields <- as.integer(input$numfields) lapply(1:numfields, function(i) { textinput(paste0("field", i), paste0("type in field ", i)) }) }) output$morefields <- renderui({ if (input$gobutton == 0) return(null) isolate({ numfields <- as.integer(input$numfields) lapply(1:numfields, function(i) { checkboxinput(paste0("checkbox", i), paste0("checkbox field ", input[[paste0("field", i)]])) }) }) }) observeevent(input$gobutton2, { numfields2 <- as.integer(input$numfields2) vals$update <- 1 updatenumericinput(session, "numfields", value = numfields2) }) observeevent(vals$update, { if (vals$update != 2) return(null) numfields2 <- as.integer(input$numfields2) last_field <- paste0("field", numfields2) updatetextinput(session, "field1", value = "this first field") updatetextinput(session, last_field, value = "this last field") vals$update <- 3 }) observeevent(vals$update, { if (vals$update != 3) return(null) js$click("gobutton") vals$update <- 0 }) }) )
hope helps
Comments
Post a Comment