'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)
Sources
This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.
Source: Stack Overflow
| Solution | Source |
|---|
