Как отформатировать ввод Shiny обновленным numericInput, но не изменить фактическое значение?

Question

В следующем примере numberInput «Число C» вычисляется и обновляется как «Число A», разделенное на «Число B».Когда результат представляет собой бесконечное десятичное число, это приводит к числу с большим количеством цифр до «числа C».Я хотел бы округлить бесконечную десятичную дробь до второй или третьей цифр, чтобы облегчить чтение для «числа C».В то же время, однако, я не хочу применять функцию round к num_C, потому что в реальном мире я хочу применить «Число C» для других вычислений, и я хочу использовать число как есть.Другими словами, я хочу найти способ отформатировать внешний вид числа, но не точное значение, например отформатировать ячейку в электронной таблице Excel, чтобы показывать только ограниченные цифры, но не изменять действительное значение.Возможно ли это сделать в Shiny?

library(shiny)

# Define UI
ui <- fluidPage(
  numericInput(inputId = "A", "Number A", value = 2),
  numericInput(inputId = "B", "Number B", value = 3),
  numericInput(inputId = "C", "Number C [A/B]", value = 1)
)

# Server logic
server <- function(input, output, session){

  observe({
    req(input$A, input$B)
    num_C <- input$A/input$B
    updateNumericInput(
      inputId = "C",
      session = session,
      value = num_C
    )
  })
}

# Complete app with UI and server components
shinyApp(ui, server)

Answer 1

Вы можете использовать выражение reactive для num_C

library(shiny)

# Define UI
ui <- fluidPage(
  numericInput(inputId = "A", "Number A", value = 2),
  numericInput(inputId = "B", "Number B", value = 3),
  numericInput(inputId = "C", "Number C [A/B]", value = 1)
)

# Server logic
server <- function(input, output, session){

  num_C <- reactive({
      req(input$A, input$B)
      input$A / input$B
  })

  observe(
      updateNumericInput(
          inputId = "C",
          session = session,
          value = format(num_C(), digits = 2))
      )

}

# Complete app with UI and server components
shinyApp(ui, server)

num_C(), чтобы затем вернуть значение «без округления», тогда как мы используем округленное значение format(num_C(), digits = 2) в updateNumericInput.

---

Частичное обновление

Для чего оно стоит, вот неполное обновление

library(shiny)

# Define UI
ui <- fluidPage(
  numericInput(inputId = "A", "Number A", value = 2),
  numericInput(inputId = "B", "Number B", value = 3),
  numericInput(inputId = "C", "Number C [A/B]", value = 1),
  textOutput("value"),
  textOutput("rounded_value")
)

# Server logic
server <- function(input, output, session){

  num_C <- reactiveValues(
      value = NULL,
      rounded_value = NULL
  )

  observeEvent(input$A | input$B, {
      num_C$value <- input$A / input$B
      num_C$rounded_value <- round(num_C$value, 1)
  })

  observeEvent(input$C, {
      num_C$value <- input$C
      num_C$rounded_value <- input$C
  })

  output$value <- renderText(
      sprintf("Number C = %f", num_C$value)
  )
  output$rounded_value <- renderText(
      sprintf("Number C (rounded) = %f", num_C$rounded_value)
  )

}

# Complete app with UI and server components
shinyApp(ui, server)

Идея состоит в том, чтобы использовать reactiveValues для отслеживания полной точности иокругленное значение числа C. Это работает, поскольку

1. при изменении чисел от A, B до numericInput будет правильно рассчитывать (и отображать) полную точность и округленные числа для C в textOutputs.
2. при изменении числа от C до numericInput также будет правильно отображаться полное значение точности (равное округленному) в textOutput s.

Однако , мне не удалось использовать updateNumericInput для обновления значения для C с округленным числом, когда были изменены числа A и B.

Продолжение следует ...

Answer 2

Самое простое, что нужно сделать, это посчитать, как долго будет input$C, и применить округление - при сохранении истинного значения в качестве фиктивной переменной:

library(shiny)
#this counts the decimal places of a value
decimalplaces <- function(x) {
  if ((x %% 1) != 0) {
    nchar(strsplit(sub('0+$', '', as.character(x)), ".", fixed=TRUE)[[1]][[2]])
  } else {
    return(0)
  }
}

# Define UI
ui <- fluidPage(
  numericInput(inputId = "A", "Number A", value = 2),
  numericInput(inputId = "B", "Number B", value = 3),
  numericInput(inputId = "C", "Number C [A/B]", value = 1)
)

# Server logic
server <- function(input, output, session){
  num_C <- reactiveValues(
    value = NULL
  )

  observeEvent(input$A|input$B,{

    num_C$value <- input$A/input$B
    updateNumericInput(
      inputId = "C",
      session = session,
      value = round(num_C$value,2)
    )
  })

  observeEvent(input$C, {
    #identify if num_C is greater than 2 dc
  if(decimalplaces(input$C)>2){
    num_C$value <- input$C
  }
    updateNumericInput(
      inputId = "C",
      session = session,
      value = round(num_C$value,2)
    )

  })
  #check that everything is working correctly. 
  observeEvent( input$A|input$B|input$C,{
    print(paste0(num_C$value," ", input$C))
  })
}

# Complete app with UI and server components
shinyApp(ui, server)

спасибо @Maurits Evers за большую часть кода.

Answer 3

Я просто немного изменил код Маврикия, добавив flag и observeEvent для value <- reactiveValue(), который содержит фактическое значение. Теперь «C» всегда будет отображать округленное значение, но value будет хранить фактическое значение.

Надеюсь, это полезно ...

library(shiny)

# Define UI
ui <- fluidPage(
  numericInput(inputId = "A", "Number A", value = 2),
  numericInput(inputId = "B", "Number B", value = 2),
  numericInput(inputId = "C", "Number C [A/B]", value = 1),
  textOutput("value"),
  textOutput("rounded_value")
)

# Server logic
server <- function(input, output, session){

  value <- reactiveVal(1)
  rounded_value <- reactiveVal()
  flag <- reactiveVal(T)

  observeEvent(input$A | input$B, {
    value(input$A / input$B)
    rounded_value(round(value(), 2))
  })


  observeEvent(input$C, {
    if(flag()){
      value(input$C)
      rounded_value(round(input$C, 2))
    }else{
      flag(T)
    }
  })

  observeEvent(value(),{
    flag(F)
    updateNumericInput(session, "C", value = rounded_value())
  })



  output$value <- renderText(
    sprintf("Number C = %f", value())
  )
  output$rounded_value <- renderText(
    sprintf("Number C (rounded) = %f", rounded_value())
  )

}

# Complete app with UI and server components
shinyApp(ui, server)