i'm building new shiny app , although works, code extensive , not reactive wanted. right have @ server.r
daydata <- reactive({...}) pday <- function(data){...} output$distplotday <- renderplot(function() {print(pday(daydata)) }) and @ ui.r
plotoutput("distplotday") for each variable in
checkboxgroupinput("checkgroup", "dataset features:", choices = c("day","hour","source","service","relevancy","tollfree","distance","similarity")) but wish more fancy this:
shinyserver(function(input, output, session) { ... output$sliders <- renderui({ lapply(input$checkgroup, function(i) { fluidrow( column(4, selectinput(paste0('trans',i), i, choices = c('linear','quadratic','sine')) , conditionalpanel( condition = "input[[paste0('trans',i)]]== 'sine'", withmathjax(), h5("put in initial kicks for: $$a*\\sin(b*x+c)+d$$"), textinput3(paste0('trans',i,'a'), h5('a:'), value = 10), textinput3(paste0('trans',i,'b'), h5('c:'), value = 1), textinput3(paste0('trans',i,'c'), h5('d:'), value = 0.1), helptext("note: b has been picked up") ), plotoutput(paste0('distplot',i)) )) }) }) ... })) .
shinyui(navbarpage("", tabpanel("data", sidebarlayout( sidebarpanel( checkboxgroupinput("checkgroup", label = h5("dataset features:"), choices = c("day","hour","source","service","relevancy","tollfree","distance","similarity"), inline = f, selected = c("day","hour","source","service","relevancy","tollfree","distance","similarity")) ), mainpanel( numericinput("obs", label = h5("number of observations view"), 15, min = 10, max = 20, step = 1), tableoutput("view") ) ) ), tabpanel("variable transformation", uioutput(outputid = "sliders")) )) using lapply , renderui.
plotoutput(paste0('distplot',i)) is not ploting anything, , the
conditionalpanel(condition = "input[[paste0('trans',i)]]== 'sine'",...) don't show conditionally, instead it's there.
any suggestions? help!
i wasn't sure wanted plotoutput call, since far can tell there wasn't example code included linked it. however, managed put working example dynamically showing/hiding selection boxes , text fields sine parameters.
i found easier implement moving ui generation server ui. gets around problem of conditions being evaluated input doesn't exist yet, since on ui side functions writing html.
an additional benefit way input fields don't re-rendered every time checkbox input changes - means values persist through toggling them on , off, , enabling or disabling single variable won't cause others' values reset.
the code:
library(shiny) vars <- c("day","hour","source","service","relevancy", "tollfree","distance","similarity") ui <- shinyui(navbarpage("", tabpanel("data", sidebarlayout( sidebarpanel( checkboxgroupinput("checkgroup", label = h5("dataset features:"), choices = c("day","hour","source","service","relevancy", "tollfree","distance","similarity"), inline = f, selected = c("day", "hour","source","service","relevancy", "tollfree","distance","similarity") ) ), mainpanel( numericinput("obs", label = h5("number of observations view"), value = 15, min = 10, max = 20, step = 1), tableoutput("view") ) ) ), tabpanel("variable transformation", fluidrow( column(4, lapply(vars, function(i) { div( conditionalpanel( condition = # javascript expression check box # variable checked in input paste0("input['checkgroup'].indexof('", i,"') != -1"), selectinput(paste0('trans',i), i, choices = c('linear','quadratic','sine')) ), conditionalpanel( condition = paste0("input['trans", i, "'] == 'sine' ", " && input['checkgroup'].indexof('", i,"') != -1"), withmathjax(), h5("put in initial kicks for: $$a*\\sin(b*x+c)+d$$"), textinput(paste0('trans',i,'a'), h5('a:'), value = 10), textinput(paste0('trans',i,'b'), h5('c:'), value = 1), textinput(paste0('trans',i,'c'), h5('d:'), value = 0.1), helptext("note: b has been picked up") ) ) }) ) ) ) )) server <- shinyserver(function(input, output, session) {}) shinyapp(ui, server) ps. dynamically showing/hiding or enabling/disabling objects, package shinyjs dean attali (link) has nice tools allow call basic javascript using r syntax.
Comments
Post a Comment