我下面有一个闪亮的应用程序，最初显示一个checkBoxGroupButtons()和一个表格。该表有 5 行(只是示例 - 通常更多)，如果您单击一行，则会显示另一个表。
复选框组有 2 个选项Elective和Non-elective Long Stay。在这个版本中，我只在代码的第 78-79 行中使用data[,2]和data[,1]Elective计算。Non-elective Long Stay的相应计算将data[,4]而不是data[2,]和data[3,]而不是data[1,]。
初始表用于提供为计算选择的索引或行。
因此，例如，如果我选择Elective和第一行，我应该基于第一行取一个表格，总共有 2 列(现在只有Elective
)，如果我选择，那么Elective和Non-elective Long Stay将添加另一列与相对计算。
如果我单击另一行，假设第 3 行，它将与之前的第 1 行一起包含在计算中。
如果未选择任何内容，则不显示任何表。
汇总时，复选框设置显示的服务类型和行选择，以均值计算中包括的行的索引。
library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(data.table)
library(dplyr)
library(DT)
library(devtools)
filtercost<-structure(list(Currency = c("A01A1", "A01AG", "A01C1", "A01CG",
"A03"), `Currency Description` = c("Other Therapist, Adult, One to One",
"Other Therapist, Adult, Group", "Other Therapist, Child, One to One",
"Other Therapist, Child, Group", "Dietitian")), row.names = c(NA,
-5L), class = c("tbl_df", "tbl", "data.frame"))
datacost<-structure(list(Elective_Activity = c(110, 134, 167, 241, 247),
`Elective_Unit Cost` = c(9329, 5105, 3354, 3116, 2429), `Non-elective Long Stay_Activity` = c(2957,
1899, 2049, 2220, 3388), `Non-elective Long Stay_Unit Cost` = c(6877,
5455, 3822, 3385, 2533)), row.names = c(NA, -5L), class = c("tbl_df",
"tbl", "data.frame"))
header <- dashboardHeader(title = "National Schedule of NHS Costs")
sidebar <- dashboardSidebar(
)
body <- dashboardBody(fluidPage(
checkboxGroupButtons(
inputId = "somevalue2",
label = "Choose service type:",
choices = c("Elective","Non-elective Long Stay"),
justified = F,
status = "primary",
checkIcon = list(
yes = icon("ok",
lib = "glyphicon"),
no = icon("remove",
lib = "glyphicon"))
),
box(width = 12,DT::dataTableOutput('selectedrow_costs')),
box(width = 12,DT::dataTableOutput('costs'), height = 150))
)
ui <- dashboardPage(title = 'Search', header, sidebar, body)
server <- function(input, output, session) {
output$costs <- DT::renderDataTable({
dtable <- datatable(
filtercost, selection = "multiple",rownames=FALSE
)
dep <- htmltools::htmlDependency("jqueryui", "1.12.1",
"www/shared/jqueryui",
script = "jquery-ui.min.js",
package = "shiny")
dtable$dependencies <- c(dtable$dependencies, list(dep))
dtable
})
#output$value2 <- renderPrint({ input$somevalue2 })
selectedrow_costsrows <- eventReactive(input$costs_rows_selected, {
#req(input$costs_rows_selected)
s <- input$costs_rows_selected
data <- as.data.frame(datacost[s,])
names(data) <- NULL
data
elective_mean<- weighted.mean(as.numeric(data[,2]),as.numeric(data[,1]),na.rm = F)
elective_se<- sqrt(as.numeric(data[,1])*((as.numeric(data[,2])-elective_mean)^2)/sum(as.numeric(data[,1])))
elective_CI_l<- elective_mean-1.96*elective_se
elective_CI_h<- elective_mean+1.96*elective_se
Service_type <- c("Elective")
Weighted_mean <- round(c(elective_mean),0)
Weighted_SR <- round(c(elective_se),0)
CI_Lower_95 <- round(c(elective_CI_l),0)
CI_Upeer_95 <- round(c(elective_CI_h),0)
costtable <- as.data.frame(rbind(Service_type,Weighted_mean,Weighted_SR,CI_Lower_95,CI_Upeer_95))
costtable
})
output$selectedrow_costs <- DT::renderDataTable({
df=selectedrow_costsrows()})
}
shinyApp(ui = ui, server = server)
也许这将满足您的需求。 请注意，您可能需要修改elective_se和elective_se2的公式。
server <- function(input, output, session) {
output$costs <- DT::renderDataTable({
dtable <- datatable(
filtercost, selection = "multiple",rownames=FALSE
)
dep <- htmltools::htmlDependency("jqueryui", "1.12.1",
"www/shared/jqueryui",
script = "jquery-ui.min.js",
package = "shiny")
dtable$dependencies <- c(dtable$dependencies, list(dep))
dtable
})
#output$value2 <- renderPrint({ input$somevalue2 })
selectedrow_costsrows <- reactive({
#req(input$costs_rows_selected)
s <- input$costs_rows_selected
data <- as.data.frame(datacost[s,])
names(data) <- NULL
data
if (is.null(input$costs_rows_selected)) {costtable <- NULL
}else {
n <- length(input$costs_rows_selected)
elective_mean<- weighted.mean(as.numeric(data[,2]),as.numeric(data[,1]),na.rm = F)
elective_se <- ifelse(n>1, sqrt(sum((as.numeric(data[,2])-elective_mean)^2)/(n*(n-1))), 0)
elective_CI_l<- elective_mean-1.96*elective_se
elective_CI_h<- elective_mean+1.96*elective_se
Service_type <- c("Elective")
Weighted_mean <- round(c(elective_mean),0)
Weighted_SR <- round(c(elective_se),0)
CI_Lower_95 <- round(c(elective_CI_l),0)
CI_Upeer_95 <- round(c(elective_CI_h),0)
costtable1 <- as.data.frame(rbind(Service_type,Weighted_mean,Weighted_SR,CI_Lower_95,CI_Upeer_95))
elective_mean2<- weighted.mean(as.numeric(data[,4]),as.numeric(data[,3]),na.rm = F)
elective_se2 <- ifelse(n>1, sqrt(sum((as.numeric(data[,4])-elective_mean2)^2)/(n*(n-1))), 0)
elective_CI_l2<- elective_mean2 - 1.96*elective_se2
elective_CI_h2<- elective_mean2 + 1.96*elective_se2
Service_type2 <- c("Non-elective Long Stay")
Weighted_mean2 <- round(c(elective_mean2),0)
Weighted_SR2 <- round(c(elective_se2),0)
CI_Lower_952 <- round(c(elective_CI_l2),0)
CI_Upeer_952 <- round(c(elective_CI_h2),0)
costtable2 <- as.data.frame(rbind(Service_type2,Weighted_mean2,Weighted_SR2,CI_Lower_952,CI_Upeer_952))
colnames(costtable2) <- "V2"
if (is.null(input$somevalue2)) {costtable <- NULL
}else if (length(input$somevalue2)==2){
costtable <- cbind(costtable1,costtable2)
}else{
if (input$somevalue2=="Elective"){
costtable <- costtable1
}else {
costtable <- costtable2
}
}
}
costtable
})
output$selectedrow_costs <- DT::renderDataTable({
df=selectedrow_costsrows()})
}
shinyApp(ui = ui, server = server)