0

I am trying to dynamically render multiple text output from multiple text input. I tried to use this very helpfull example and this one too. This conversation is also helpfull. But when I try to adapt this examples on the following script, I have a problem of output update. Apparently, only the last element was read and updated. It's probably a reactivity problem but it seems to be difficult to associate reactive{()} and renderUI{()}functions.

rm(list = ls())
library(shiny)

creatDataElem <- function(ne, input) {
    x1 <- lapply(1:ne, function(i) {
    textInput(paste0("elemName", i),
          label = h4(strong("Name of dataset element")),
          value = "")
   })
   return(x1)
}

ui = (fluidPage(
         sidebarLayout(
           sidebarPanel(
             sliderInput("elemNb",
                         "Number of elements", value = 1, min = 1,
                         max = 3)
             ,
             conditionalPanel(
               condition = "input.elemNb == 1",
               creatDataElem(1)
             ),
             conditionalPanel(
               condition = "input.elemNb == 2",
               creatDataElem(2)
             ),
             conditionalPanel(
               condition = "input.elemNb == 3",
               creatDataElem(3)
             )
           ),
         mainPanel(
           uiOutput("nameElem")
         )
       )
      )
   )

server = function(input, output, session) {

max_elem <- 3
# Name

output$nameElem <-renderUI({
  nameElem_output_list <- lapply(1:input$elemNb, function(i) {
    elemName <- paste0("elemName", i)
    tags$div(class = "group-output",
             verbatimTextOutput(elemName)
    )
  })
  do.call(tagList, nameElem_output_list)
})

for (i in 1:max_elem) {
  local({
    force(i)
    my_i <- i
    elemName <- paste0("elemName", my_i)
    output[[elemName]] <- renderPrint(input[[elemName]])
  })
}
}

runApp(list(ui = ui, server = server))

The idea with a reactive({}) function is to add an independant object (a function in this case) like:

nameElem <- reactive({
  if (input$goElem == 0) {
    return()
  } else {
    isolate({
      if (is.null(input$elemName)) {
         return()
      } else if (test(input$elemName)) {
         return("TEST RESULT")
      } else {
         return(input$elemName)
      }
   })
 }
})

and to use renderUI on this object (with an ActionButton). So, if someone knows why the output does not return the good object...

Community
  • 1
  • 1
Philippe
  • 194
  • 1
  • 12

2 Answers2

1

I think one of your problems is that your creatDataElem function is such that when it is called with argument ne=3, the first and second textInput elements are created again (and their value "lost").

Anyway, I think one solution would be to create those textInput elements as an "uiOutput".

You'll find a possible solution below which (I think) does what you want.

Lise

rm(list = ls())
library(shiny)

ui = (fluidPage(
  sidebarLayout(
    sidebarPanel(
      sliderInput("elemNb",
                  "Number of elements", value = 1, min = 1,
                  max = 3),
      uiOutput("myUI")    
    ),
    mainPanel(
      uiOutput("nameElem")
    )
  )
)
)

server = function(input, output, session) {
  output$myUI=renderUI({
    w=""
    for (i in 1:input$elemNb){
      w=paste0(w,
               textInput(paste0("elemName",i),label='Name of dataset element'))
    }
    HTML(w)
  })
  output$nameElem <-renderUI({
    elems=c("<div>")
    for(i in 1:input$elemNb){
      elems=paste(elems,"</div><div>",input[[paste0("elemName",i)]])
    }
        elems=paste0(elems,"</div>")
        HTML(elems)
      })
}

runApp(list(ui = ui, server = server))
lvaudor
  • 113
  • 5
  • thx it seems to be a good solution to resolve the problem. I had not suspected the `creatDataElem` function. – Philippe Sep 23 '15 at 06:56
  • but here, `HTML` seems to work only for character strings (a text as says the help of the `HTML` function). So, is it possible to do the same for other R objects, like `dataframe` or `vector` for example? – Philippe Sep 23 '15 at 08:25
0

Found a solution:

library(readr)
library(dplyr)
library(shiny)

df <-  data.frame(symbol = 1:10)

uiOutput("myUI")

createUI <- function(dfID, symbol) {
    div(class="flex-box",paste0(symbol, " - 10"))
  }
output$myUI <- renderUI({

    w <- lapply(seq_len(nrow(df)), function(i) {
      createUI(i, df[i,"symbol"])
    })

    do.call(fluidPage,w)
})
Aaron Soderstrom
  • 599
  • 1
  • 6
  • 12