i have 15 select (input type) fields. , need pass server function prediction , show resultant output. i don't want auto-update, when user sets value 1 input field, instead want user set values (15 input fields) , press type of button output.
how achieve that? first shiny ui application.
mycode
library(shiny) dataset <- diamonds marks <- 0:100 grades <- c("a","b","c","d","e","f") ui <- fluidpage( tags$head(tags$style(html(" h2 { text-align: center; } h3 { text-align: center; } h6 { text-align: center; color:red; } #gobutton { width: 100%; } ") ) ), verticallayout ( wellpanel ( titlepanel("get recommendation year 4 or 5 courses"), h6("* set value of input field 'na', if received remark of absent (abs), medical circumstances (mc), exemption (ex), synoptic course in absence (nc), discretionary credits (dc), or other reason") ) ), fluidrow ( column(2, wellpanel( radiobuttons("type", label = h3("select type"), choices = list("grades" = 'grades', "marks" = 'marks'), selected = 'grades') ) ), conditionalpanel ( condition = "input.type == 'grades'", column (2, wellpanel ( h3("year 1"), selectinput('a', 'a',c('na', grades)), selectinput('b', 'b',c('na', grades)), selectinput('c', 'c',c('na', grades)), selectinput('d', 'd',c('na', grades)), selectinput('e', 'e',c('na', grades)) ) ), column (2, wellpanel ( h3("year 2"), selectinput('f', 'f',c('na', grades)), selectinput('g', 'g',c('na', grades)), selectinput('h', 'h',c('na', grades)), selectinput('i', 'i',c('na', grades)), selectinput('j', 'j',c('na', grades)) ) ), column (2, wellpanel ( h3("year 3"), selectinput('k', 'k',c('na', grades)), selectinput('l', 'l',c('na', grades)), selectinput('m', 'm',c('na', grades)), selectinput('n', 'n',c('na', grades)), selectinput('o', 'o',c('na', grades)) ) ) ), conditionalpanel ( condition = "input.type == 'marks'", column (2, wellpanel ( h3("year 1"), selectinput('a', 'a',c('na', marks)), selectinput('b', 'b',c('na', marks)), selectinput('c', 'c',c('na', marks)), selectinput('d', 'd',c('na', marks)), selectinput('e', 'e',c('na', marks)) ) ), column (2, wellpanel ( h3("year 2"), selectinput('f', 'f',c('na', marks)), selectinput('g', 'g',c('na', marks)), selectinput('h', 'h',c('na', marks)), selectinput('i', 'i',c('na', marks)), selectinput('j', 'j',c('na', marks)) ) ), column (2, wellpanel ( h3("year 3"), selectinput('k', 'k',c('na', marks)), selectinput('l', 'l',c('na', marks)), selectinput('m', 'm',c('na', marks)), selectinput('n', 'n',c('na', marks)), selectinput('o', 'o',c('na', marks)) ) ) ), column (4, actionbutton("gobutton", "submit"), wellpanel ( h3("results"), verbatimtextoutput("value") ) ) ) ) server <- function(input, output) { #do prediction #get results new_vector = c() if (input.type == 'marks'){ new_vector <- append(new_vector, input$f27sa, 1) new_vector <- append(new_vector, input$f27sb, 2) new_vector <- append(new_vector, input$f27cs, 3) new_vector <- append(new_vector, input$f27is, 4) new_vector <- append(new_vector, input$f27px, 5) new_vector <- append(new_vector, input$f28in, 6) new_vector <- append(new_vector, input$f28da, 7) new_vector <- append(new_vector, input$f28pl, 8) new_vector <- append(new_vector, input$f28sd, 9) new_vector <- append(new_vector, input$f28dm, 10) new_vector <- append(new_vector, input$f28ai, 11) new_vector <- append(new_vector, input$f28fa, 12) new_vector <- append(new_vector, input$f28fb, 13) new_vector <- append(new_vector, input$f28oc, 14) new_vector <- append(new_vector, input$f28pd, 15) }else{ new_vector <- append(new_vector, input$f27sa2, 1) new_vector <- append(new_vector, input$f27sb2, 2) new_vector <- append(new_vector, input$f27cs2, 3) new_vector <- append(new_vector, input$f27is2, 4) new_vector <- append(new_vector, input$f27px2, 5) new_vector <- append(new_vector, input$f28in2, 6) new_vector <- append(new_vector, input$f28da2, 7) new_vector <- append(new_vector, input$f28pl2, 8) new_vector <- append(new_vector, input$f28sd2, 9) new_vector <- append(new_vector, input$f28dm2, 10) new_vector <- append(new_vector, input$f28ai2, 11) new_vector <- append(new_vector, input$f28fa2, 12) new_vector <- append(new_vector, input$f28fb2, 13) new_vector <- append(new_vector, input$f28oc2, 14) new_vector <- append(new_vector, input$f28pd2, 15) } results <- eventreactive(input$gobutton,{ return (new_vector) }) output$value <- renderprint({ results() }) } shinyapp(ui = ui, server = server) 
eventreactive way approach this.
here example modified returns "result 1" if 1 of 3 conditions true
- the year1
input$a=="a" - the year2
input$f=="a" - the year3
input$k=="a"
otherwise returns "result 3". note doesn't return @ until hit submit button.
somehow eventreactive not known in shiny world - kind of scenario meant for. didn't stumble across until had been writing shiny programs regularly on year.
library(shiny) dataset <- diamonds marks <- 0:100 grades <- c("a","b","c","d","e","f") ui <- fluidpage( tags$head(tags$style(html(" h2 { text-align: center; } h3 { text-align: center; } h6 { text-align: center; color:red; } #gobutton { width: 100%; } ") ) ), verticallayout ( wellpanel ( titlepanel("get recommendation year 4 or 5 courses"), h6("* set value of input field 'na', if received remark of absent (abs), medical circumstances (mc), exemption (ex), synoptic course in absence (nc), discretionary credits (dc), or other reason") ) ), fluidrow ( column(2, wellpanel( radiobuttons("type", label = h3("select type"), choices = list("grades" = 'grades', "marks" = 'marks'), selected = 'grades') ) ), conditionalpanel ( condition = "input.type == 'grades'", column (2, wellpanel ( h3("year 1"), selectinput('a', 'a',c('na', grades)), selectinput('b', 'b',c('na', grades)), selectinput('c', 'c',c('na', grades)), selectinput('d', 'd',c('na', grades)), selectinput('e', 'e',c('na', grades)) ) ), column (2, wellpanel ( h3("year 2"), selectinput('f', 'f',c('na', grades)), selectinput('g', 'g',c('na', grades)), selectinput('h', 'h',c('na', grades)), selectinput('i', 'i',c('na', grades)), selectinput('j', 'j',c('na', grades)) ) ), column (2, wellpanel ( h3("year 3"), selectinput('k', 'k',c('na', grades)), selectinput('l', 'l',c('na', grades)), selectinput('m', 'm',c('na', grades)), selectinput('n', 'n',c('na', grades)), selectinput('o', 'o',c('na', grades)) ) ) ), conditionalpanel ( condition = "input.type == 'marks'", column (2, wellpanel ( h3("year 1"), selectinput('a', 'a',c('na', marks)), selectinput('b', 'b',c('na', marks)), selectinput('c', 'c',c('na', marks)), selectinput('d', 'd',c('na', marks)), selectinput('e', 'e',c('na', marks)) ) ), column (2, wellpanel ( h3("year 2"), selectinput('f', 'f',c('na', marks)), selectinput('g', 'g',c('na', marks)), selectinput('h', 'h',c('na', marks)), selectinput('i', 'i',c('na', marks)), selectinput('j', 'j',c('na', marks)) ) ), column (2, wellpanel ( h3("year 3"), selectinput('k', 'k',c('na', marks)), selectinput('l', 'l',c('na', marks)), selectinput('m', 'm',c('na', marks)), selectinput('n', 'n',c('na', marks)), selectinput('o', 'o',c('na', marks)) ) ) ), column (4, actionbutton("gobutton", "submit"), wellpanel ( h3("results"), verbatimtextoutput("value") ) ) ) ) server <- function(input, output) { #do prediction results <- eventreactive(input$gobutton,{ if (input$k=="a" | input$f=="a" | input$a=="a" ){ return("result 1") } else { return("result 3") } }) #get results #results <- c("result 1","result 2","result 3"); output$value <- renderprint({ results() }) } shinyapp(ui = ui, server = server) 
Comments
Post a Comment