firmo23
Reputation: 8404
Create a dynamic table on shiny app based on shiny widget and row selection of another datatable
I have the shiny app below which initially displays a checkBoxGroupButtons() and a table. The table has 5 rows (just example-normally more) if you click on a row then another table is displayed.
The checkbox group has 2 choices Elective and Non-elective Long Stay. In this version I have included only calculation for Elective using data[,2] and data[,1] in lines 78-79 of my code. The respective calculations for Non-elective Long Stay will be data[,4] instead of data[2,] and data[3,] instead of data[1,].
The initial table is used to give the index or rows selected for the calculation.
So for example if I choose Elective and first row I should take a table based on 1st row and with 2 columns in total (only Elective as it is now),
If I choose then both Elective and Non-elective Long Stay another column will be added with the relative calculations.
IF I click on another row lets say row 3 it will be included in the calculations together with row 1 from earlier.
If nothing is chosen the no table is displayed.
To sum up the checkbox sets the service type displayed and the row selection the index of rows that wil be included in the means calculation.
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)
Upvotes: 2
Views: 1542
Answers (1)
YBS
Reputation: 21297
Perhaps this will meet your needs. Please note that you may need to modify the formula for elective_se and 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)
Upvotes: 1
Related Questions
- DataTable row selection inside shiny module
- Update widget values based on datatable row selection
- Select a DT row and then change the value of one cell of this row based on widget selection input and actionButton() in a shiny app
- Select specific row of a datatable with a shiny widget
- Display datatable based on certain cell selection of another datatable and in active tab in a shiny app
- add shinyWidgets into datatable in R
- Shiny: Create a dynamic datatable based on a click event on another datatable
- Select a datatable value and update it via a shiny widget
- Create datatable based on cell selection of another datatable in a shiny app
- R Shiny DataTable dynamic row selection with filtered data