z

Author: jinseob2kim

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: jsmodule
 Title: 'RStudio' Addins and 'Shiny' Modules for Medical Research
 Version: 1.0.3
-Date: 2019-11-08
+Date: 2019-11-12
 Authors@R: c(person("Jinseob", "Kim", email = "[email protected]", role = c("aut", "cre"),  comment = c(ORCID = "0000-0002-9403-605X")),
              person("Zarathu", role = c("cph", "fnd"))
              )

NEWS.md

@@ -1,6 +1,14 @@
 # jsmodule 1.0.3
 
-* Bug fixes: Incorrect p-value when applying cluster options.
+## Bug fixes
+
+* Incorrect p-value when applying cluster options.
+
+* PS matching: allow continuous variables as Independent variables
+
+## Update
+
+* PS matching: allow 1:N matching.
 
 
 # jsmodule 1.0.2

R/FilePsInput.R

@@ -60,8 +60,11 @@ FilePsInput <- function(id, label = "Upload data (csv/xlsx/sav/sas7bdat/dta)") {
     uiOutput(ns("group_ps")),
     uiOutput(ns("indep_ps")),
     uiOutput(ns("pcut")),
-    uiOutput(ns("caliperps"))
+    uiOutput(ns("caliperps")),
+    uiOutput(ns("ratio"))
   )
+
+
 }
 
 
@@ -191,7 +194,8 @@ FilePs <- function(input, output, session, nfactor.limit = 20) {
     nclass <- unlist(out[, lapply(.SD, function(x){length(unique(x))}), .SDcols = conti_vars])
     factor_adds_list = mklist(data_varStruct, names(nclass)[(nclass <= nfactor.limit) & (nclass < nrow(out))])
 
-    except_vars <- names(nclass)[ nclass== 1 | nclass >= nfactor.limit]
+    #except_vars <- names(nclass)[ nclass== 1 | nclass >= nfactor.limit]
+    except_vars <- names(nclass)[ nclass== 1]
     add_vars <- names(nclass)[nclass >= 1 &  nclass <= 5]
     #factor_vars_ini <- union(factor_vars, add_vars)
     naomit <- ifelse(length(naCol) == 0, "Data has <B>no</B> missing values.", paste("Column <B>", paste(naCol, collapse = ", "), "</B> are(is) excluded due to missing value.", sep = ""))
@@ -219,6 +223,13 @@ FilePs <- function(input, output, session, nfactor.limit = 20) {
                  selected = 0.1, inline =T)
   })
 
+  output$ratio <- renderUI({
+    if (is.null(input$file)){return(NULL)}
+    radioButtons(session$ns("ratio_ps"), label = "Case:control ratio",
+                 choices = c("1:1" = 1, "1:2" = 2, "1:3" = 3, "1:4" = 4),
+                 selected = 1, inline =T)
+  })
+
 
   observeEvent(data.info(), {
     output$factor <- renderUI({
@@ -513,15 +524,15 @@ FilePs <- function(input, output, session, nfactor.limit = 20) {
 
 
 
-  mat.info <- eventReactive(c(input$indep_pscal, input$group_pscal, input$caliper, data()), {
+  mat.info <- eventReactive(c(input$indep_pscal, input$group_pscal, input$caliper, input$ratio_ps, data()), {
     req(input$indep_pscal)
     if (is.null(input$group_pscal) | is.null(input$indep_pscal)){
       return(NULL)
     }
     data <- data.table(data()$data)
 
     forms <- as.formula(paste(input$group_pscal, " ~ ", paste(input$indep_pscal, collapse = "+"), sep=""))
-    m.out <- MatchIt::matchit(forms, data = data, caliper = input$caliper)
+    m.out <- MatchIt::matchit(forms, data = data, caliper = input$caliper, ratio = as.integer(input$ratio_ps))
     pscore <- m.out$distance
     iptw <- ifelse(m.out$treat == levels(m.out$treat)[2], 1/pscore,  1/(1-pscore))
     wdata <- cbind(data, pscore, iptw)

R/jsPropensityGadget.R

@@ -60,8 +60,8 @@ jsPropensityGadget <- function(data, nfactor.limit = 20){
   conti_original <- setdiff(names(out), factor_vars)
   nclass <- unlist(out[, lapply(.SD, function(x){length(unique(x))}), .SDcols = conti_original])
   factor_adds_list = mklist(data_varStruct1, names(nclass)[nclass <= nfactor.limit])
-
-  except_vars <- names(nclass)[ nclass== 1 | nclass >= nfactor.limit]
+  except_vars <- names(nclass)[ nclass== 1]
+  #except_vars <- names(nclass)[ nclass== 1 | nclass >= nfactor.limit]
   factor_adds <- names(nclass)[nclass >= 1 &  nclass <= 5]
 
 
@@ -85,7 +85,8 @@ jsPropensityGadget <- function(data, nfactor.limit = 20){
                                 uiOutput("group_ps"),
                                 uiOutput("indep_ps"),
                                 uiOutput("pcut"),
-                                uiOutput("caliperps")
+                                uiOutput("caliperps"),
+                                uiOutput("ratio")
 
                               ),
                               mainPanel(
@@ -307,6 +308,12 @@ jsPropensityGadget <- function(data, nfactor.limit = 20){
                    selected = 0.1, inline =T)
     })
 
+    output$ratio <- renderUI({
+      radioButtons("ratio_ps", label = "Case:control ratio",
+                   choices = c("1:1" = 1, "1:2" = 2, "1:3" = 3, "1:4" = 4),
+                   selected = 1, inline =T)
+    })
+
     output$factor <- renderUI({
       selectInput("factor_vname", label = "Additional categorical variables",
                   choices = factor_adds_list, multiple = T,
@@ -590,15 +597,15 @@ jsPropensityGadget <- function(data, nfactor.limit = 20){
 
 
 
-    mat.info <- eventReactive(c(input$indep_pscal, input$group_pscal, input$caliper, data.info()), {
+    mat.info <- eventReactive(c(input$indep_pscal, input$group_pscal, input$caliper, input$ratio_ps, data.info()), {
       req(input$indep_pscal)
       if (is.null(input$group_pscal) | is.null(input$indep_pscal)){
         return(NULL)
       }
       data <- data.table::data.table(data.info()$data)
 
       forms <- as.formula(paste(input$group_pscal, " ~ ", paste(input$indep_pscal, collapse = "+"), sep=""))
-      m.out <- MatchIt::matchit(forms, data = data, caliper = input$caliper)
+      m.out <- MatchIt::matchit(forms, data = data, caliper = input$caliper, ratio = as.integer(input$ratio_ps))
       pscore <- m.out$distance
       iptw <- ifelse(m.out$treat == levels(m.out$treat)[2], 1/pscore,  1/(1-pscore))
       wdata <- cbind(data, pscore, iptw)