在R闪亮中输入出生日期时如何自动显示年龄？

Question

在R中输入出生日期时如何自动显示年龄？ UI.R

shinyUI(
    fuildpage({
    column(2, actionButton("calculate", "Calculate age")),
    fluidRow(uiOutput("calculatedage")
})

服务器.R

library(shiny)
library(shinyjs)
library(shinythemes)

shinyServer(function(input, output,session){

    observeEvent( input$calculate, 
       output$calculatedage <- renderUI({isolate({

      fluidRow(
          column(3,dateInput("dob", label="DATE OF BIRTH:",min = "1960-01-01",
          max = Sys.Date(), format = "yyyy-mm-dd", startview = "year",
          weekstart = 0, language = "en")),

          column(3, textInput("age",label = "AGE:")),
         column(3,textInput("address",label = "Address:"))                                              
          )

  })}))           
})

在上面的代码中有一个叫做计算年龄的按钮，当点击它时，用户可以输入出生日期。当用户输入出生日期时，年龄应该自动显示在定义为“年龄”的文本框中。 如何在 R Shiny 中做到这一点

Answer 1

这个怎么样？

library(shiny)
library(shinyjs)
library(shinythemes)

ui <- shinyUI(
  fluidPage({
    column(2, actionButton("calculate", "Calculate age"),
    fluidRow(uiOutput("calculatedage")))
  })
)

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

      observeEvent( input$calculate, 
                    output$calculatedage <- renderUI({isolate({

                      fluidRow(
                        column(10,dateInput("dob", label="DATE OF BIRTH:",
                                           min = "1960-01-01",
                                           max = Sys.Date(), format = "yyyy-mm-dd", 
                                           startview = "year",
                                           weekstart = 0, language = "en")),

                        column(10, textInput("age",label = "AGE:")),
                        column(10,textInput("address",label = "Address:"))                                              
                      )

                    })}))  

      observe({   dob <- input$dob
                  if(!is.null(dob)) {
                     days <- as.integer((Sys.Date() - as.Date(dob)))
                     years <- as.integer(days / 365)
                     months <- as.integer((days %% 365 ) / 30)
                     age <- paste(years, 'year(s)', months, 'month(s)')                                          
                     #print(age)
                     updateTextInput(session, "age", value = age)
                  }

            })
 })

 shinyApp(ui = ui, server = server)

Answer 2

创建了一个动态闪亮的应用程序，因此当您输入以前的日期时，它会自动在 3 个差异列中按天、月和年计算，您可以添加尽可能多的以前的日期，它会在闪亮的应用程序中生成表格输出

library(shiny)
library(lubridate)

ui <- shinyUI( fluidPage(
                   titlePanel("Date calculator"),
                    sidebarLayout(
                    sidebarPanel(
                    textInput("Possible.date", label="Previous date", value= "2016-08-23"),
                    textInput("Current.date", label="Current .date", value=Sys.Date()),
                    actionButton("addButton", "Calculate")
                       ),
 mainPanel(
           tableOutput("table"))
           )))

server = function(input, output) {    


values <- reactiveValues()
values$df <- data.frame(Possible.date = NA, Current.date = NA, Age_days = NA ,Age_months=NA, Age_years = NA)



observeEvent(input$addButton, {

if(input$addButton >= 0) {
  # create the new line to be added from your inputs

  newLine <- isolate(c(lubridate::ymd(input$Possible.date), lubridate::ymd(input$Current.date), 
    difftime(lubridate::ymd(input$Current.date),lubridate::ymd(input$Possible.date)),
    (difftime(lubridate::ymd(input$Current.date),lubridate::ymd(input$Possible.date)))/30,
    (difftime(lubridate::ymd(input$Current.date),lubridate::ymd(input$Possible.date)))/365))
  isolate(values$df <- rbind(as.matrix(values$df), unlist(newLine)))
  }
 })

 output$table <- renderTable({values$df}, include.rownames=F)


  }

 shinyApp(ui = ui, server = server)