如何根据 R Shiny 中的输入值数量动态更新计算值？

问题描述

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

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,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",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",selected = NULL),selectInput(paste0("db","Do they have diabetes",diabetes,selectInput(paste0("ht","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",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,value = risk_level() + sar_risk_level(),title = list(text = "Overall Risk Profile"),15+(25*input*members))),b=30))
    
    fig
  })
  
}

shinyApp(ui,server)

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

解决方法

外观漂亮的应用程序。我认为这只是一个错字。代码在第 151 行有 cols = [] for col in df1: candidate = df2.loc[:,df2.columns.str.startswith(col)] cols.append(df1[col] if candidate.empty else candidate) result = pd.concat(cols,axis=1) 而不是 25*input*members。