如何解决如何根据 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
。
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。