How to disable edit option for displayed values in shiny?

Question

We are allowing the users to update anyone of the 3 inputs. Shiny calculates ratio among them and display in %. However, this displayed value is editable in shiny.

Since the displayed value is necessary for further calculation in the code, this behavior is undesirable.

Therefore, could someone help to display the values in % but allow the user not to edit them.

Please find below reprex code. Tried 1. Render as print and sprint but hard to format 2. Disabled the renderUI but then code didnt function as renderUI didnt run.

library(shiny)

ui <- fluidPage(
  column(6, 
         tags$h2("Allow the user to change only here"),
         numericInput("valueA", "Value1", value = .333, min = 0, max = 1, step = .1),
         numericInput("valueB", "Value2", value = .333, min = 0, max = 1, step = .1),
         numericInput("valueC", "Value3", value = .333, min = 0, max = 1, step = .1),
         verbatimTextOutput("result")
   ),
  column(6,
          uiOutput("ui")
   )
)

server <- function(input, output, session) {
  output$ui <- renderUI( {
    tagList(
      tags$h2("Display in % but dont allow user to change here"),
      numericInput("obs1", "Label1", value = 100 * (input$valueA / (input$valueA + input$valueB + input$valueC))),
      numericInput("obs2", "Label2", value = 100 * (input$valueB / (input$valueA + input$valueB + input$valueC))),
      numericInput("obs3", "Label3", value = 100 * (input$valueC / (input$valueA + input$valueB + input$valueC)))

    )
  })
  # Since the below option is hard to render like above 
  # output$result <- renderPrint({
  #   print(sprintf("A=%.3f, B = %.3f", 
  #                 input$obs1,input$obs2))
  # })

  #### Code to use the values from obs1,obs2,obs3....
}

shinyApp(ui, server)

Basically, 3 values where users can edit and ratios (%) should be displayed. However these percentages shouldn't be editable.

Answer 1

I was looking at doing this too, preferably I would like my UI not to look different from inputs in any way. I'm building a CRUD app and depending on what the user selects some inputs are set and locked. I figured if you simply disable pointer events on an input, then job's done. And what do you know, it works.

You simply need to wrap the input in a div, assign it an ID and then use that in a custom stylesheet to apply the css rule.

library(shiny)

# Define UI for application that draws a histogram
ui <- fluidPage(
    tags$head(
        # Note the wrapping of the string in HTML()
        tags$style(HTML("
                    .disabled-div .form-control { # target the form control inside elements classed .disabled-div
                      pointer-events: none;
                      background-color: #ddd;"))
    ),
    uiOutput("id_number")
)

# Define server logic required to draw a histogram
server <- function(input, output) {
    
    new_id = paste0(sample(1:10, 10), collapse="")
    
    output$id_number <- renderUI({
        tags$div(
            id="id-number-div",
            class="disabled-div",
            numericInput("id_number",
                         "ID Number",
                         new_id))
    })
}

# Run the application 
shinyApp(ui = ui, server = server)enter code here

Answer 2

Ok, I think I got what you want to do. You need to store the values in either a reactive "variable" or in reactive values (that both can listen to input changes). The following examples shows both options and also that you can work with these for later.

library(shiny)

ui <- fluidPage(
  column(6, 
         tags$h2("Allow the user to change only here"),
         numericInput("valueA", "Value1", value = .333, min = 0, max = 1, step = .1),
         numericInput("valueB", "Value2", value = .333, min = 0, max = 1, step = .1),
         numericInput("valueC", "Value3", value = .333, min = 0, max = 1, step = .1),
         verbatimTextOutput("result")
  ),
  column(6,
         uiOutput("ui1"),
         tags$hr(),
         uiOutput("ui2"),
         tags$hr(),
         tags$h3("Obs1 * 2"),
         verbatimTextOutput("obs1")
  )
)

server <- function(input, output, session) {

  ### reactive "variables"
  obs1 <- reactive({
    as.numeric(100 * (input$valueA / (input$valueA + input$valueB + input$valueC)))
  })
  obs2 <- reactive({
    as.numeric(100 * (input$valueB / (input$valueA + input$valueB + input$valueC)))
  })
  obs3 <- reactive({
    as.numeric(100 * (input$valueC / (input$valueA + input$valueB + input$valueC)))
  })
  ### or as reative values which I like more
  # create
  obs <- reactiveValues(obs1 = NULL,
                        obs2 = NULL,
                        obs3 = NULL)
  # listen to changes
  observe({
    obs$obs1 <- as.numeric(100 * (input$valueA / (input$valueA + input$valueB + input$valueC)))
    obs$obs2 <- as.numeric(100 * (input$valueB / (input$valueA + input$valueB + input$valueC)))
    obs$obs3 <- as.numeric(100 * (input$valueC / (input$valueA + input$valueB + input$valueC)))
  })

  ### render ui of reactives variable
  # ! note the function notation of obs1() to obs3()
  output$ui1 <- renderUI( {
    tagList(
      tags$h3("Display in % but dont allow user to change here"),
      renderText( obs1() ),
      renderText( obs2() ),
      renderText( obs3() )
    )
  })

  ### render ui of reactive values
  # ! note: variable called as a normal list
  output$ui2 <- renderUI( {
    tagList(
      tags$h3("Display in % but dont allow user to change here"),
      renderText( obs$obs1 ),
      renderText( obs$obs2 ),
      renderText( obs$obs3 )
    )
  })

  ### Code to use the values from obs1,obs2,obs3....
  output$obs1<- renderText(obs$obs1 * 2)
}

shinyApp(ui, server)

Answer 3

I would prefer to print it as verbatimeTextOutput, but this is not possible in renderUi (as far a I know). renderText works in the renderUI but must be the output is not so nice in line. What I don't understand? Why don't you allow to enter percent and recalculate if you need 0-1 values.

library(shiny)

ui <- fluidPage(
  column(6, 
         tags$h2("Allow the user to change only here"),
         numericInput("valueA", "Value1", value = .333, min = 0, max = 1, step = .1),
         numericInput("valueB", "Value2", value = .333, min = 0, max = 1, step = .1),
         numericInput("valueC", "Value3", value = .333, min = 0, max = 1, step = .1),
         verbatimTextOutput("result")
  ),
  column(6,
         uiOutput("ui")
  )
)

server <- function(input, output, session) {
  output$ui <- renderUI( {
    tagList(
      tags$h2("Display in % but dont allow user to change here"),
      renderText(paste(100 * (input$valueA / (input$valueA + input$valueB + input$valueC)))),
      renderText(paste(value = 100 * (input$valueB / (input$valueA + input$valueB + input$valueC)))),
      renderText(paste(value = 100 * (input$valueC / (input$valueA + input$valueB + input$valueC))))
    )
  })
  # Since the below option is hard to render like above 
  output$result <- renderText({
    paste(100 * (input$valueA / (input$valueA + input$valueB + input$valueC)),'%')
  })

  #### Code to use the values from obs1,obs2,obs3....
}

shinyApp(ui, server)