Tidying up meta-analysis. adding I^2 statistics

thehyve · Oct 4, 2018 · cf15884 · cf15884
1 parent 94df8a3
commit cf15884
Show file tree

Hide file tree

Showing 3 changed files with 32 additions and 7 deletions.
diff --git a/LegendBasicViewer/global.R b/LegendBasicViewer/global.R
@@ -31,13 +31,14 @@ exposures$exposureGroup[exposures$exposureGroup == "Drug" | exposures$exposureGr
 exposureGroups <- unique(exposures[, c("indicationId", "exposureGroup")])
 outcomes <- getOutcomes(connection)
 databases <- getDatabases(connection)
+metaAnalysisDbIds <- databases$databaseId[databases$isMetaAnalysis == 1]
 analyses <- getAnalyses(connection)
 subgroups <- getSubgroups(connection)
 # Sort for display:
 indications <- indications[order(indications$indicationId), ]
 exposures <- exposures[order(exposures$exposureName), ]
 outcomes <- outcomes[order(outcomes$outcomeName), ]
-databases <- databases[order(databases$databaseId), ]
+databases <- databases[order(databases$isMetaAnalysis, databases$databaseId), ]
 analyses <- analyses[order(analyses$analysisId), ]
 subgroups <- subgroups[order(subgroups$subgroupId), ]
 

diff --git a/LegendBasicViewer/server.R b/LegendBasicViewer/server.R
@@ -95,6 +95,26 @@ shinyServer(function(input, output, session) {
   })
   outputOptions(output, "rowIsSelected", suspendWhenHidden = FALSE)
 
+  output$isMetaAnalysis <- reactive({
+    row <- selectedRow()
+    isMetaAnalysis <- !is.null(row) && (row$databaseId %in% metaAnalysisDbIds)
+    if (isMetaAnalysis) {
+      hideTab("detailsTabsetPanel", "Attrition")
+      hideTab("detailsTabsetPanel", "Population characteristics")
+      hideTab("detailsTabsetPanel", "Propensity scores")
+      hideTab("detailsTabsetPanel", "Covariate balance")
+      hideTab("detailsTabsetPanel", "Kaplan-Meier")
+    } else {
+      showTab("detailsTabsetPanel", "Attrition")
+      showTab("detailsTabsetPanel", "Population characteristics")
+      showTab("detailsTabsetPanel", "Propensity scores")
+      showTab("detailsTabsetPanel", "Covariate balance")
+      showTab("detailsTabsetPanel", "Kaplan-Meier")    
+    }
+    return(isMetaAnalysis)
+  })
+  outputOptions(output, "isMetaAnalysis", suspendWhenHidden = FALSE)
+
   balance <- reactive({
      row <- selectedRow()
      if (is.null(row)) {
@@ -177,20 +197,23 @@ shinyServer(function(input, output, session) {
                            "Target IR (per 1,000 PY)",
                            "Comparator IR (per 1,000 PY)",
                            "MDRR")
+      if (row$databaseId %in% metaAnalysisDbIds) {
+        table$i2 <- sprintf("%.2f", as.numeric(row$i2))
+      }
       return(table)
     }
   })
 
   output$timeAtRiskTableCaption <- renderUI({
     row <- selectedRow()
-    if (!is.null(row)) {
+    if (is.null(row)) {
+      return(NULL)
+    } else {
       text <- "<strong>Table 1b.</strong> Time (days) at risk distribution expressed as
       minimum (min), 25th percentile (P25), median, 75th percentile (P75), and maximum (max) in the target
      (<em>%s</em>) and comparator (<em>%s</em>) cohort after %s."
       return(HTML(sprintf(text, input$target, input$comparator, row$psStrategy)))
-    } else {
-      return(NULL)
-    }
+    } 
   })
 
   output$timeAtRiskTable <- renderTable({

diff --git a/LegendBasicViewer/ui.R b/LegendBasicViewer/ui.R
@@ -47,8 +47,9 @@ shinyUI(
                                                                        tabPanel("Power",
                                                                                 uiOutput("powerTableCaption"),
                                                                                 tableOutput("powerTable"),
-                                                                                uiOutput("timeAtRiskTableCaption"),
-                                                                                tableOutput("timeAtRiskTable")
+                                                                                conditionalPanel("output.isMetaAnalysis == false",
+                                                                                                 uiOutput("timeAtRiskTableCaption"),
+                                                                                                 tableOutput("timeAtRiskTable"))
                                                                        ),
                                                                        tabPanel("Attrition",
                                                                                 plotOutput("attritionPlot", width = 600, height = 600),