如果在R闪亮中输入出生日期时如何自动显示年龄? UI.R
shinyUI(
fuildpage({
column(2, actionButton("calculate", "Calculate age")),
fluidRow(uiOutput("calculatedage")
})
SERVER.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:"))
)
})}))
})
在上面的代码中有一个名为calculate age的按钮,当点击该按钮时用户可以输入dob。当用户输入dob时,年龄应该自动显示在文本框中定义的“age”。 怎么能在R闪亮
中完成答案 0 :(得分:0)
这个怎么样?
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)
答案 1 :(得分:0)
创建了一个动态闪亮的应用程序,因此当您输入以前的日期时,它会自动计算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)