r - 如何禁用闪亮显示值的编辑选项？

Question

我们允许用户更新 3 个输入中的任何一个。Shiny 计算其中的比率并以% 显示。但是，这个显示的值是可以编辑的。

由于显示的值对于代码中的进一步计算是必需的，因此这种行为是不可取的。

因此，有人可以帮助以 % 显示值，但允许用户不要编辑它们。

请在下面找到代表代码。尝试过 1. 渲染为打印和冲刺，但难以格式化 2. 禁用了 renderUI，但代码没有运行，因为 renderUI 没有运行。

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)

基本上，应该显示用户可以编辑的 3 个值和比率 (%)。然而，这些百分比不应该是可编辑的。

Answer 1

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)

Answer 2

好的，我想我得到了你想要做的。您需要将值存储在反应式“变量”或反应式值（两者都可以监听输入更改）中。以下示例显示了这两个选项，并且您可以在以后使用这些选项。

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

我也在考虑这样做，最好我希望我的 UI 看起来不会与输入有任何不同。我正在构建一个 CRUD 应用程序，并根据用户选择的内容设置和锁定一些输入。我想如果你只是在输入上禁用指针事件，那么工作就完成了。你知道吗，它有效。

您只需将输入包装在一个 div 中，为其分配一个 ID，然后在自定义样式表中使用它来应用 css 规则。

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