Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
255 views
in Technique[技术] by (71.8m points)

shiny - Saving Dynamic UI to Global R workspace

I am trying to create a Shiny App which can be used in the R workspace to create a user friendly front end to some code- so that someone can just type in and click some boxes instead of creating lists and dataframes themselves- and then what they input will be stored in the workspace in R to do the code. I have basically adapted someone else's code but can't work out how I save the dynamically created UI called col - which makes text inputs so if people type something in this is saved.

When I try to add some way of saving it I get an error Operation not allowed without an active reactive context. (You tried to do something that can only be done from inside a reactive expression or observer.). The code is below, is there a way I can save the information from the text input?

CrossBreakUI <- function(id, number) {

  ns <- NS(id)

  tagList(
    fluidRow(
      column(4,   numericInput(ns("n"), "Number of Groups in Cross-Break", value=5, min=1),     uiOutput(ns("col")))

    )
  )


}


variables <- function(input, output, session, variable.number){
  output$textInput <- renderUI({
    ns <- session$ns
    textInput(ns("textInput"),
              label = "")
  })


  col_names <- reactive(paste0("col", seq_len(input$n)))
  output$col <- renderUI({
    ns <- session$ns
    map(col_names(), ~ textInput(ns(.x), NULL))
  })


  reactive({



    # Create Pair: variable and its value
    df <- data.frame(
      "variable.number" = variable.number,

      stringsAsFactors = FALSE
    )



  })



}

ui <- fixedPage(

  div(
    CrossBreakUI("var1", 1)



  ))


server <- function(input, output) {




  add.variable <- reactiveValues()
  add.variable$df <- data.frame(
    "n" = numeric(0),
    "col" = character(0),
    stringsAsFactors = FALSE

  )


   var1 <- callModule(variables, paste0("var", 1), 1)



  observeEvent(input[[NS(paste0("var", 1), "n")]], {
    add.variable$df[1,1] <- input[[NS(paste0("var", 1), "n")]]
  })
**#THIS IS THE ERROR- IT DOES NOT SAVE THE TEXT INPUT FROM THIS VARIABLE**  
  observeEvent(input[[NS(paste0("var", 1), "col")]], {
    add.variable$df[1,2] <- input[[NS(paste0("var", 1), "col")]]
  })


observe({
    assign(x ="CrossBreak", value=add.variable$df, envir= .GlobalEnv) })

}
See Question&Answers more detail:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Reply

0 votes
by (71.8m points)

Second revision

If my understanding is correct, I think this gets close to what you want. You have a numericInput. The UI presents a series of textInputs. The number of textInputs changes in response to changes in the numericInput's value. The values of the textInputs are saved to a variable in the global environment (and the value of this global variable is printed to the console as the app terminates). Values already entered in the textInputs are preserved when the UI updates.

My solution differs from yours in that you have one module attempting to control every textInput and a main server that attempts to interrogate each textInput to obtain its value. I use multiple instances of a single module, one for each textInput. Each module instance manages the persistence of its textInput's value independently of all the other instances.

library(shiny)

groupList <- list()

# Module to define a self-contained "write-my-value" textInput 
writeMyValueTextInputUI <- function(id, idx) {
  ns <- NS(id)

  textInput(ns("groupName"), paste0("Group ", idx))
}

writeMyValueTextInput <- function(input, output, session, id) {
  ns <- session$ns

  # Initialise
  observe ({
    id <- as.numeric(id)
    if (id <= length(groupList)) updateTextInput(session, "groupName", value=groupList[[id]])
  })

  observeEvent(input$groupName, {
    req(input$groupName)
    # Note global assignment
    groupList[[id]] <<- input$groupName
  })

  rv <- reactive ({
    input$groupName
  })

  return(rv)
}

ui <- fluidPage(
   titlePanel("Crossbreak demo"),
   sidebarLayout(
      sidebarPanel(
        numericInput("groupCount", "Number of groups in cross-break:", min=1, value=5),
      ),
      mainPanel(
        textOutput("groupCount"),
        uiOutput("groupList")
      )
   )
)

server <- function(input, output, session) {
  onStop(function() cat(paste0(groupList, collapse=", ")))
  ns <- session$ns

  controllers <- list()

  output$groupList <- renderUI({
    req(input$groupCount)
    textInputs <- lapply(
                    1:input$groupCount,
                    function(x) {
                      id <- ns(paste0("text", x))
                      controllers[[x]] <- callModule(writeMyValueTextInput, id, x)
                      return(writeMyValueTextInputUI(id, x))
                     }
                  )
    do.call(tagList, textInputs)
  })
}

shinyApp(ui = ui, server = server)

=========================
I haven't tried running your code (it's not really a simple self-contained example), but the following is just one way of running an app from the console. (is that what you mean when you say "from the global environment?)...

myList <- list(
  ui = bootstrapPage(
    numericInput('n', 'Number of obs', 100),
    plotOutput('plot')
  ),
  server = function(input, output) {
    output$plot <- renderPlot({ hist(runif(input$n)) })
  }
)

if (interactive()) runApp(myList)

I based my code on this page which also has other examples...

Note that you can't do this if you're running an R script in a batch job, as the batch job has no context in which to display the app. Hence if (interactive())...

OK. Responding to OP's clarification, here's a really crude demonstraion of one way of doing what she wants. Note the use of the global assignment operator (<<-) in the observeEvent.

x <- NA
print(paste0("globalValue is currently: ", x))

myList <- list(
  ui = bootstrapPage(
    numericInput('n', 'Please give me a number', 100)
  ),
  server = function(input, output) {
    observeEvent(input$n, {x <<- input$n})
  }
)

if (interactive()) runApp(myList)
print(paste0("globalValue is now: ", x))

On my system, stepping through these statements in the console gives:

> x <- NA
> print(paste0("globalValue is currently: ", x))
[1] "globalValue is currently: NA"
> myList <- list(
+   ui = bootstrapPage(
+     numericInput('n', 'Please give me a number', 100)
+   ),
+   server = function(input, output) {
+     observeEvent(input$n, {x <<- input$n})
+   }
+ )
> if (interactive()) runApp(myList)

Listening on http://127.0.0.1:4429

> print(paste0("globalValue is now: ", x))
[1] "globalValue is now: 104"
> 

Obviously, this isn't a realistic production solution. Possible solutions might include:

  • Writing to a temporary Rds file in the app and then reading it in once the app terminates.
  • Using session$userData to store the required information whilst the app is running and then using onStop to do custom processing as the app terminates.

I'm sure there will be others.

[OP: As an aside, look at the length of my code compared to yours. Put yourself in the shoes of someone who's willing to provide solutions. Whose question are they most likely to answer: yours or mine? Providing compact, relevant code makes it far more likely you'll get a useful reply.]


与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
OGeek|极客中国-欢迎来到极客的世界,一个免费开放的程序员编程交流平台!开放,进步,分享!让技术改变生活,让极客改变未来! Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...