基于另一个数据表的闪亮小部件和行选择，在闪亮应用程序上创建动态表 [英] Create a dynamic table on shiny app based on shiny widget and row selection of another datatable
本文介绍了基于另一个数据表的闪亮小部件和行选择，在闪亮应用程序上创建动态表的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
checkBoxGroupButtons()和一个表。该表有5行(仅作为示例-通常更多)，如果您单击一行，则会显示另一个表。
复选框组有两个选项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行一起包括在计算中。
如果未选择任何内容，则显示NO表。
总而言之，该复选框设置显示的服务类型和行选择，即将包括在平均值计算中的行的索引。
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)
这篇关于基于另一个数据表的闪亮小部件和行选择，在闪亮应用程序上创建动态表的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
查看全文
