简体   繁体   中英

How to format the input of Shiny updated numericInput but not change the actual value?

In the following example, the numberInput "Number C" is calculated and updated as "Number A" divided "Number B". When the result is an infinite decimal, this leads to a number with lots of digits to "Number C". I would like to round the infinite decimal to the second or third the digits, making the appearance easier to read for "Number C". In the same time, however, I don't want to apply the round function to num_C because in the real world I want to apply "Number C" for other calculation and I want to use the number as is. In other words, I want to find a way to format the number's appearance but not the acutal value, like format a cell in an Excel spreadsheet to show only limited digits but not change the acutal value. Is this possible to do in 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)

You could use a reactive expression for 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() will then return the "un-rounded" value, whereas we use the rounded value format(num_C(), digits = 2) in updateNumericInput .


A partial update

For what it's worth, here's an incomplete update

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)

The idea is to use reactiveValues to track the full precision and rounded value of number C. This works in as far as

  1. changing numbers A, B through numericInput will correctly calculate (and display) the full precision and rounded numbers for C in the textOutput s.
  2. changing number C through numericInput will also correctly display the full precision number (which is equal to the rounded) in the textOutput s.

However , I've been unsuccessful with using updateNumericInput to update the value for C with the rounded number when numbers A and B were changed.

To be continued...

I just changed the code of Maurits a little bit by adding a flag and an observeEvent for the value <- reactiveValue() that holds the actual value. Now, "C" will always show the rounded value, but value will store the actual.

I hope this is useful...

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)

Simpliest thing to do would be to count how long input$C is and apply a rounding figure - while saving the true value as a dummy variable:

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)

thanks to @Maurits Evers for the majority of the code.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM