How to disable edit option for displayed values in shiny?

[AbhishekHP]

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.

[FJCC]

The formatting needs work but I think the output is basically what you want.

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"),
    tags$p(style="padding-top: 20px", "Value1"),
    tags$span(style="padding-bottom: 20px",
             paste(format(100 * (input$valueA / (input$valueA + input$valueB + input$valueC)), 
                    digits = 3),"%")),
    tags$p(style="padding-top: 20px", "Value2"),
    tags$span(style="padding-bottom: 20px",
              paste(format(100 * (input$valueB / (input$valueA + input$valueB + input$valueC)), 
                     digits = 3),"%")),
    tags$p(style="padding-top: 20px", "Value3"),
    tags$span(style="padding-bottom: 20px",
              paste(format(100 * (input$valueC / (input$valueA + input$valueB + input$valueC)), 
                     digits = 3), "%")))}) 
}

shinyApp(ui, server)

[AbhishekHP]

Thanks for code that satisfy need to be non-editable

However, as indicated, we would need obs1,obs2 and obs3 for future calculation. When we use renderText, we remove the ID i.e obs1, is there an alternative way ?

[FJCC]

You can store the calculation results in a function. They will then be available elsewhere in the server() function.

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) {
  
  OBS <- reactive({
    Obs1 <- 100 * (input$valueA / (input$valueA + input$valueB + input$valueC))
    Obs2 <- 100 * (input$valueB / (input$valueA + input$valueB + input$valueC))
    Obs3 <- 100 * (input$valueC / (input$valueA + input$valueB + input$valueC))
    list(Obs1 = Obs1, Obs2 = Obs2, Obs3 = Obs3)
  })
  
  output$ui <- renderUI(
    {tagList(
      tags$h2("Display in % but dont allow user to change here"),
      tags$p(style="padding-top: 20px", "Value1"),
      tags$span(style="padding-bottom: 20px",
                paste(format(OBS()$Obs1, digits = 3),"%")),
      tags$p(style="padding-top: 20px", "Value2"),
      tags$span(style="padding-bottom: 20px",
                paste(format(OBS()$Obs2, digits = 3),"%")),
      tags$p(style="padding-top: 20px", "Value3"),
      tags$span(style="padding-bottom: 20px",
                paste(format(OBS()$Obs3,digits = 3), "%")))})
}

shinyApp(ui, server)

[AbhishekHP]

@FJCC Thanks for great solution. I was wondering if these percentages could also be displayed as slider. Basically showing the % would be more user friendly than text.

[FJCC]

Wouldn't a column chart fill that need?

library(shiny)
library(ggplot2)

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,
         plotOutput("plt")
  )
)

server <- function(input, output, session) {
  
  OBS <- reactive({
    Obs1 <- 100 * (input$valueA / (input$valueA + input$valueB + input$valueC))
    Obs2 <- 100 * (input$valueB / (input$valueA + input$valueB + input$valueC))
    Obs3 <- 100 * (input$valueC / (input$valueA + input$valueB + input$valueC))
    data.frame(Category = c("Value1", "Value2", "Value3"), 
               Percent = c(Obs1, Obs2, Obs3))
  })

  output$plt <- renderPlot({
    ggplot(data = OBS(), aes(Category, Percent)) + geom_col(fill = "skyblue")
  })
    
}

shinyApp(ui, server)

[AbhishekHP]

Amazingly creative you are @FJCC

Ideally, I was looking for slider as it was highly intuitive. But probably, I might be wrong in my expectation. Possibly, it is not possible, I guess. Because if we make slider, then it would allow the user to edit it which is undesirable.

[FJCC]

Yes, I avoided using sliders because that would allow the user to adjust them. You can make the graph look something like a set of sliders, as shown below. I am sure much more could be done with that but I am not one to give much help with improving appearance. If I had to make a living as a graphic designer, I would starve.

library(shiny)
library(ggplot2)

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,
         plotOutput("plt")
  )
)

server <- function(input, output, session) {
  
  OBS <- reactive({
    Obs1 <- 100 * (input$valueA / (input$valueA + input$valueB + input$valueC))
    Obs2 <- 100 * (input$valueB / (input$valueA + input$valueB + input$valueC))
    Obs3 <- 100 * (input$valueC / (input$valueA + input$valueB + input$valueC))
    data.frame(Category = c("Value1", "Value2", "Value3"), 
               Percent = c(Obs1, Obs2, Obs3),
               X = c("X", "X", "X"))
  })
  
  output$plt <- renderPlot({
    ggplot(data = OBS(), aes(X, Percent)) + geom_point(size = 4) + 
      coord_flip() + ylim(0, 100) + facet_wrap(~Category, nrow = 3) +
      labs(x = "")
  })
  
}

shinyApp(ui, server)

[AbhishekHP]

Thanks for your insights, currently trying to use shiny:div here using width as %