根据闪亮的小部件和另一个数据的行选择在闪亮的应用程序上创建动态 tabletable
Create a dynamic table on shiny app based on shiny widget and row selection of another datatable
我有一个闪亮的应用程序，它最初显示一个 checkBoxGroupButtons() 和一个 table。 table 有 5 行（只是示例 - 通常更多）如果您单击一行然后显示另一个 table。
复选框组有 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,]。
首字母table用于给出为计算选择的索引或行。
例如，如果我选择 Elective 和第一行，我应该根据第一行采用 table，总共有 2 列（现在只有 Elective） ,
如果我选择，那么 Elective 和 Non-elective Long Stay 都会添加另一列进行相关计算。
如果我单击另一行，假设第 3 行，它将与之前的第 1 行一起包含在计算中。
如果未选择任何内容，则不会显示 table。
总结一下，复选框设置显示的服务类型，行选择设置将包含在均值计算中的行的索引。
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)
我有一个闪亮的应用程序，它最初显示一个 checkBoxGroupButtons() 和一个 table。 table 有 5 行（只是示例 - 通常更多）如果您单击一行然后显示另一个 table。
复选框组有 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,]。
首字母table用于给出为计算选择的索引或行。
例如，如果我选择 Elective 和第一行，我应该根据第一行采用 table，总共有 2 列（现在只有 Elective） ,
如果我选择，那么 Elective 和 Non-elective Long Stay 都会添加另一列进行相关计算。
如果我单击另一行，假设第 3 行，它将与之前的第 1 行一起包含在计算中。
如果未选择任何内容，则不会显示 table。
总结一下，复选框设置显示的服务类型，行选择设置将包含在均值计算中的行的索引。
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)