0

我正在尝试更新 R Shiny 中的绘图图表中的值，其计算值取决于输入的数量

library(shiny)
library(httr)
library(jsonlite)
library(dplyr)
library(plotly)
library(shinythemes)
library(flexdashboard)
library(shinydashboard)

setwd("X:/Work/Covid-19 Project/Shiny Dashboard")

rp_1 <- read.csv("Data/Risk Profile 1.csv")
rp_2 <- read.csv("Data/Risk Profile 2.csv")

gender <- c("Male","Female")
age <- c("Less than 20 years", "20 to 50 years","More than 50 years")
city <- c("Delhi","Chennai")
diabetes <- c("Have diabetes","Don't have diabetes")
hypertension <- c("Have hypertension","Don't have hypertension")

risk_level_est <- function(city, gender, age, db, ht){
  p_inv <- as.numeric(rp_1 %>%
                        filter(City == city & Gender == gender) %>%
                        select(Prob))
  
  p_adv <- as.numeric(rp_2 %>%
                        filter(Age == age & Diabetes == db & Hypertension == ht) %>%
                        summarise(Hosp + Death))
  
  as.numeric(p_inv*p_adv*100)
}

sar_risk_level_est <- function(age, db, ht){
  p_adv <- as.numeric(rp_2 %>%
                        filter(Age == age & Diabetes == db & Hypertension == ht) %>%
                        summarise(Hosp + Death))
  
  as.numeric(0.2*p_adv*100)
}

about_page <- tabPanel(
  title = "About",
  titlePanel("About"),
  "Created with R Shiny",
  br(),
  "2021 April"
)

main_page <- tabPanel(
  title = "Estimator",
  titlePanel(""),
  sidebarLayout(
    sidebarPanel(
      title = "Inputs",
      selectInput("gender", "Select your gender", gender),
      selectInput("age", "Select your age", age),
      selectInput("city", "Select your city", city),
      selectInput("db", "Do you have diabetes", diabetes),
      selectInput("ht", "Do you have hypertension", hypertension),
      radioButtons("radio", "Do you want to include your household members",
                   choices = list("No" = 1,"Yes" = 2)),
      conditionalPanel("input.radio == 2",
                       numericInput("members", label = "How many household members do you have?", value='1'),
                       uiOutput("member_input")
      ),
      actionButton("risk","Calculate my risk profile")
    ),
    mainPanel(
      tabsetPanel(
        tabPanel(
          title = "Risk Profile",
          plotlyOutput("risk_profile", height = 250, width = "75%"),
          plotlyOutput("overall_risk_profile", height = 250, width = "75%")
        )
      )
    )
  )
)

ui <- navbarPage(
  title = "Risk Estimator",
  theme = shinytheme('united'),
  main_page,
  about_page
)


server <- function(input, output, session) {
  
  output$member_input <- renderUI({
    
    numMembers <- as.integer(input$members)
    
    lapply(1:numMembers, function(i) {
      list(tags$p(tags$u(h4(paste0("Member ", i)))),
           selectInput(paste0("age", i), "Select their age", age, selected = NULL),
           selectInput(paste0("db", i), "Do they have diabetes", diabetes, selected = NULL),
           selectInput(paste0("ht", i), "Do they have hypertension", hypertension, selected = NULL))
    })
  })
  
  risk_level <- eventReactive(input$risk, {
    risk_level_est(input$city, input$gender, input$age, input$db, input$ht)
  })
  
  sar_risk_level <- eventReactive(input$risk,{
    
    sar_risk <- 0
    
    lapply(1:input$members, function(i){
      sar_risk <- sar_risk + sar_risk_level_est(input[[paste0("age", i)]],input[[paste0("db", i)]],input[[paste0("ht", i)]])
    })
    
    as.numeric(sar_risk)
  })
  
  output$risk_profile <- renderPlotly({
    
    fig <- plot_ly(
      domain = list(x = c(0, 1), y = c(0, 1)),
      value = risk_level(),
      title = list(text = "Personal Risk Profile"),
      type = "indicator",
      mode = "gauge+number",
      gauge = list(
        axis = list(range = list(0, 15)),
        bar = list(color = "gray"),
        bgcolor = "white",
        borderwidth = 2,
        bordercolor = "gray",
        steps = list(
          list(range = c(0, 3.75), color = "darkgreen"),
          list(range = c(3.75, 7.5), color = "chartreuse"),
          list(range = c(7.5,11.25), color = "orange"),
          list(range = c(11.25,15), color = "red")
        ))) 
    fig <- fig %>% layout(margin = list(l=30, r=30, t=80, b=30))
    
    fig
  })
  
  output$overall_risk_profile <- renderPlotly({
    
    fig <- plot_ly(
      domain = list(x = c(0, 1), y = c(0, 1)),
      value = risk_level() + sar_risk_level(),
      title = list(text = "Overall Risk Profile"),
      type = "indicator",
      mode = "gauge+number",
      gauge = list(
        axis = list(range = list(0, 15+(25*input*members))),
        bar = list(color = "gray"),
        bgcolor = "white",
        borderwidth = 2,
        bordercolor = "gray",
        steps = list(
          list(range = c(0, 3.75), color = "darkgreen"),
          list(range = c(3.75, 7.5), color = "chartreuse"),
          list(range = c(7.5,11.25), color = "orange"),
          list(range = c(11.25,15), color = "red")
        ))) 
    fig <- fig %>% layout(margin = list(l=30, r=30, t=80, b=30))
    
    fig
  })
  
}

shinyApp(ui, server)

虽然 risk_profile 图工作正常，但overall_risk_profile 图会抛出“非数字参数到二元运算符”错误。total_risk_profile 中的 sar_risk_level() 值取决于计算 (sar_risk_level_est)，该计算取决于输入的数量。我希望这个值（sar_risk）被初始化为零并在每次按下操作按钮时更新。

4

1 回答 1

0

很棒的应用程序。我认为这只是一个错字。代码有25*input*members而不是25*input$members在第 151 行。

于 2021-05-11T14:11:00.920 回答