From dfb6adc9f601f9f03eb3f21435eb93c0ff3b5c46 Mon Sep 17 00:00:00 2001 From: Jinseob Kim Date: Wed, 3 Mar 2021 10:17:25 +0900 Subject: [PATCH] z --- CRAN-RELEASE | 4 ++-- DESCRIPTION | 4 ++-- NEWS.md | 6 ++++++ R/FilePsInput.R | 12 ++++++------ R/FileRepeatedInput.R | 12 ++++++------ R/FileSurveyInput.R | 12 ++++++------ R/coxph.R | 6 +++--- R/csvFileInput.R | 12 ++++++------ R/gee.R | 12 ++++++------ R/jsBasicGadget.R | 12 ++++++------ R/jsPropensityGadget.R | 12 ++++++------ R/jsRepeatedGadget.R | 12 ++++++------ R/jsSurveyGadget.R | 12 ++++++------ R/kaplan.R | 6 +++--- R/regress.R | 6 +++--- R/roc.R | 6 +++--- R/scatter.R | 6 +++--- R/timeroc.R | 6 +++--- 18 files changed, 82 insertions(+), 76 deletions(-) diff --git a/CRAN-RELEASE b/CRAN-RELEASE index a405b288..8dac1acf 100644 --- a/CRAN-RELEASE +++ b/CRAN-RELEASE @@ -1,2 +1,2 @@ -This package was submitted to CRAN on 2020-07-09. -Once it is accepted, delete this file and tag the release (commit 7c23b88a64). +This package was submitted to CRAN on 2021-02-15. +Once it is accepted, delete this file and tag the release (commit f3ccb08). diff --git a/DESCRIPTION b/DESCRIPTION index 3fdd22c1..4c2db9b8 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: jsmodule Title: 'RStudio' Addins and 'Shiny' Modules for Medical Research -Version: 1.1.6 -Date: 2021-02-02 +Version: 1.1.7 +Date: 2021-03-03 Authors@R: c(person("Jinseob", "Kim", email = "jinseob2kim@gmail.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-9403-605X")), person("Zarathu", role = c("cph", "fnd")) ) diff --git a/NEWS.md b/NEWS.md index ee062c16..2bb71025 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,9 @@ +# jsmodule 1.1.7 + +## Bug fix + +* Label info in subgroup analysis: regression, cox + # jsmodule 1.1.6 ## Fix & update diff --git a/R/FilePsInput.R b/R/FilePsInput.R index ddc43ca5..d8b538d3 100644 --- a/R/FilePsInput.R +++ b/R/FilePsInput.R @@ -435,17 +435,17 @@ FilePs <- function(input, output, session, nfactor.limit = 20) { out <- out[get(input$var_subset[[v]]) %in% input[[paste0("val_subset", v)]]] #var.factor <- c(data()$factor_original, input$factor_vname) out[, (var.factor) := lapply(.SD, factor), .SDcols = var.factor] - out.label2 <- mk.lev(out)[, c("variable", "class", "level")] - data.table::setkey(out.label, "variable", "class", "level") - data.table::setkey(out.label2, "variable", "class", "level") + out.label2 <- mk.lev(out)[, c("variable", "level")] + data.table::setkey(out.label, "variable", "level") + data.table::setkey(out.label2, "variable", "level") out.label <- out.label[out.label2] } else{ out <- out[get(input$var_subset[[v]]) >= input[[paste0("val_subset", v)]][1] & get(input$var_subset[[v]]) <= input[[paste0("val_subset", v)]][2]] #var.factor <- c(data()$factor_original, input$factor_vname) out[, (var.factor) := lapply(.SD, factor), .SDcols = var.factor] - out.label2 <- mk.lev(out)[, c("variable", "class", "level")] - data.table::setkey(out.label, "variable", "class", "level") - data.table::setkey(out.label2, "variable", "class", "level") + out.label2 <- mk.lev(out)[, c("variable", "level")] + data.table::setkey(out.label, "variable", "level") + data.table::setkey(out.label2, "variable", "level") out.label <- out.label[out.label2] } } diff --git a/R/FileRepeatedInput.R b/R/FileRepeatedInput.R index c0bf983c..5f1f192f 100644 --- a/R/FileRepeatedInput.R +++ b/R/FileRepeatedInput.R @@ -381,17 +381,17 @@ FileRepeated <- function(input, output, session, nfactor.limit = 20) { out <- out[get(input$var_subset[[v]]) %in% input[[paste0("val_subset", v)]]] #var.factor <- c(data()$factor_original, input$factor_vname) out[, (var.factor) := lapply(.SD, factor), .SDcols = var.factor] - out.label2 <- mk.lev(out)[, c("variable", "class", "level")] - data.table::setkey(out.label, "variable", "class", "level") - data.table::setkey(out.label2, "variable", "class", "level") + out.label2 <- mk.lev(out)[, c("variable", "level")] + data.table::setkey(out.label, "variable", "level") + data.table::setkey(out.label2, "variable", "level") out.label <- out.label[out.label2] } else{ out <- out[get(input$var_subset[[v]]) >= input[[paste0("val_subset", v)]][1] & get(input$var_subset[[v]]) <= input[[paste0("val_subset", v)]][2]] #var.factor <- c(data()$factor_original, input$factor_vname) out[, (var.factor) := lapply(.SD, factor), .SDcols = var.factor] - out.label2 <- mk.lev(out)[, c("variable", "class", "level")] - data.table::setkey(out.label, "variable", "class", "level") - data.table::setkey(out.label2, "variable", "class", "level") + out.label2 <- mk.lev(out)[, c("variable", "level")] + data.table::setkey(out.label, "variable", "level") + data.table::setkey(out.label2, "variable", "level") out.label <- out.label[out.label2] } } diff --git a/R/FileSurveyInput.R b/R/FileSurveyInput.R index d2542e55..23ee2231 100644 --- a/R/FileSurveyInput.R +++ b/R/FileSurveyInput.R @@ -450,9 +450,9 @@ FileSurvey <- function(input, output, session, nfactor.limit = 20) { # error = function(e){return(survey::svydesign(id = cluster.survey, strata = strata.survey, weights = weights.survey, data = out, nest = T))}) #var.factor <- c(data()$factor_original, input$factor_vname) out[, (var.factor) := lapply(.SD, factor), .SDcols = var.factor] - out.label2 <- mk.lev(out)[, c("variable", "class", "level")] - data.table::setkey(out.label, "variable", "class", "level") - data.table::setkey(out.label2, "variable", "class", "level") + out.label2 <- mk.lev(out)[, c("variable", "level")] + data.table::setkey(out.label, "variable", "level") + data.table::setkey(out.label2, "variable", "level") out.label <- out.label[out.label2] } else{ out <- out[get(input$var_subset[[v]]) >= input[[paste0("val_subset", v)]][1] & get(input$var_subset[[v]]) <= input[[paste0("val_subset", v)]][2]] @@ -462,9 +462,9 @@ FileSurvey <- function(input, output, session, nfactor.limit = 20) { #var.factor <- c(data()$factor_original, input$factor_vname) out[, (var.factor) := lapply(.SD, factor), .SDcols = var.factor] - out.label2 <- mk.lev(out)[, c("variable", "class", "level")] - data.table::setkey(out.label, "variable", "class", "level") - data.table::setkey(out.label2, "variable", "class", "level") + out.label2 <- mk.lev(out)[, c("variable", "level")] + data.table::setkey(out.label, "variable", "level") + data.table::setkey(out.label2, "variable", "level") out.label <- out.label[out.label2] } } diff --git a/R/coxph.R b/R/coxph.R index 12af4164..4a8dca85 100644 --- a/R/coxph.R +++ b/R/coxph.R @@ -366,9 +366,9 @@ coxModule <- function(input, output, session, data, data_label, data_varStruct = } data.cox[, (vlist()$factor_vars) := lapply(.SD, factor), .SDcols = vlist()$factor_vars] - label.regress2 <- mk.lev(data.cox)[, c("variable", "class", "level")] - data.table::setkey(data_label(), "variable", "class", "level") - data.table::setkey(label.regress2, "variable", "class", "level") + label.regress2 <- mk.lev(data.cox)[, c("variable", "level")] + data.table::setkey(data_label(), "variable", "level") + data.table::setkey(label.regress2, "variable", "level") label.regress <- data_label()[label.regress2] data.cox[[input$event_cox]] <- as.numeric(as.vector(data.cox[[input$event_cox]])) diff --git a/R/csvFileInput.R b/R/csvFileInput.R index ac460cfa..746dbf4f 100644 --- a/R/csvFileInput.R +++ b/R/csvFileInput.R @@ -377,17 +377,17 @@ csvFile <- function(input, output, session, nfactor.limit = 20) { out <- out[get(input$var_subset[[v]]) %in% input[[paste0("val_subset", v)]]] #var.factor <- c(data()$factor_original, input$factor_vname) out[, (var.factor) := lapply(.SD, factor), .SDcols = var.factor] - out.label2 <- mk.lev(out)[, c("variable", "class", "level")] - data.table::setkey(out.label, "variable", "class", "level") - data.table::setkey(out.label2, "variable", "class", "level") + out.label2 <- mk.lev(out)[, c("variable", "level")] + data.table::setkey(out.label, "variable", "level") + data.table::setkey(out.label2, "variable", "level") out.label <- out.label[out.label2] } else{ out <- out[get(input$var_subset[[v]]) >= input[[paste0("val_subset", v)]][1] & get(input$var_subset[[v]]) <= input[[paste0("val_subset", v)]][2]] #var.factor <- c(data()$factor_original, input$factor_vname) out[, (var.factor) := lapply(.SD, factor), .SDcols = var.factor] - out.label2 <- mk.lev(out)[, c("variable", "class", "level")] - data.table::setkey(out.label, "variable", "class", "level") - data.table::setkey(out.label2, "variable", "class", "level") + out.label2 <- mk.lev(out)[, c("variable", "level")] + data.table::setkey(out.label, "variable", "level") + data.table::setkey(out.label2, "variable", "level") out.label <- out.label[out.label2] } } diff --git a/R/gee.R b/R/gee.R index 9fee9b51..eecb3925 100644 --- a/R/gee.R +++ b/R/gee.R @@ -262,9 +262,9 @@ GEEModuleLinear <- function(input, output, session, data, data_label, data_varSt } } data.regress[, (vlist()$factor_vars) := lapply(.SD, factor), .SDcols = vlist()$factor_vars] - label.regress2 <- mk.lev(data.regress)[, c("variable", "class", "level")] - data.table::setkey(data_label(), "variable", "class", "level") - data.table::setkey(label.regress2, "variable", "class", "level") + label.regress2 <- mk.lev(data.regress)[, c("variable", "level")] + data.table::setkey(data_label(), "variable", "level") + data.table::setkey(label.regress2, "variable", "level") label.regress <- data_label()[label.regress2] } y <- input$dep_vars @@ -518,9 +518,9 @@ GEEModuleLogistic <- function(input, output, session, data, data_label, data_var } } data.logistic[, (vlist()$factor_vars) := lapply(.SD, factor), .SDcols = vlist()$factor_vars] - label.regress2 <- mk.lev(data.logistic)[, c("variable", "class", "level")] - data.table::setkey(data_label(), "variable", "class", "level") - data.table::setkey(label.regress2, "variable", "class", "level") + label.regress2 <- mk.lev(data.logistic)[, c("variable", "level")] + data.table::setkey(data_label(), "variable", "level") + data.table::setkey(label.regress2, "variable", "level") label.regress <- data_label()[label.regress2] } y <- input$dep_vars diff --git a/R/jsBasicGadget.R b/R/jsBasicGadget.R index 40400222..a8c949c4 100644 --- a/R/jsBasicGadget.R +++ b/R/jsBasicGadget.R @@ -374,17 +374,17 @@ jsBasicGadget <- function(data, nfactor.limit = 20) { out <- out[get(input$var_subset[[v]]) %in% input[[paste0("val_subset", v)]]] #var.factor <- c(data()$factor_original, input$factor_vname) out[, (var.factor) := lapply(.SD, factor), .SDcols = var.factor] - out.label2 <- mk.lev(out)[, c("variable", "class", "level")] - data.table::setkey(out.label, "variable", "class", "level") - data.table::setkey(out.label2, "variable", "class", "level") + out.label2 <- mk.lev(out)[, c("variable", "level")] + data.table::setkey(out.label, "variable", "level") + data.table::setkey(out.label2, "variable", "level") out.label <- out.label[out.label2] } else{ out <- out[get(input$var_subset[[v]]) >= input[[paste0("val_subset", v)]][1] & get(input$var_subset[[v]]) <= input[[paste0("val_subset", v)]][2]] #var.factor <- c(data()$factor_original, input$factor_vname) out[, (var.factor) := lapply(.SD, factor), .SDcols = var.factor] - out.label2 <- mk.lev(out)[, c("variable", "class", "level")] - data.table::setkey(out.label, "variable", "class", "level") - data.table::setkey(out.label2, "variable", "class", "level") + out.label2 <- mk.lev(out)[, c("variable", "level")] + data.table::setkey(out.label, "variable", "level") + data.table::setkey(out.label2, "variable", "level") out.label <- out.label[out.label2] } } diff --git a/R/jsPropensityGadget.R b/R/jsPropensityGadget.R index ae18bd44..b4d097fb 100644 --- a/R/jsPropensityGadget.R +++ b/R/jsPropensityGadget.R @@ -504,18 +504,18 @@ jsPropensityGadget <- function(data, nfactor.limit = 20){ out1 <- out1[get(input$var_subset[[v]]) %in% input[[paste0("val_subset", v)]]] #var.factor <- c(data()$factor_original, input$factor_vname) out1[, (var.factor) := lapply(.SD, factor), .SDcols = var.factor] - out.label2 <- mk.lev(out1)[, c("variable", "class", "level")] - data.table::setkey(out.label, "variable", "class", "level") - data.table::setkey(out.label2, "variable", "class", "level") + out.label2 <- mk.lev(out1)[, c("variable", "level")] + data.table::setkey(out.label, "variable", "level") + data.table::setkey(out.label2, "variable", "level") out.label <- out.label[out.label2] } else{ out1 <- out1[get(input$var_subset[[v]]) >= input[[paste0("val_subset", v)]][1] & get(input$var_subset[[v]]) <= input[[paste0("val_subset", v)]][2]] #var.factor <- c(data()$factor_original, input$factor_vname) out1[, (var.factor) := lapply(.SD, factor), .SDcols = var.factor] - out.label2 <- mk.lev(out1)[, c("variable", "class", "level")] - data.table::setkey(out.label, "variable", "class", "level") - data.table::setkey(out.label2, "variable", "class", "level") + out.label2 <- mk.lev(out1)[, c("variable", "level")] + data.table::setkey(out.label, "variable", "level") + data.table::setkey(out.label2, "variable", "level") out.label <- out.label[out.label2] } } diff --git a/R/jsRepeatedGadget.R b/R/jsRepeatedGadget.R index 719af83e..8884236b 100644 --- a/R/jsRepeatedGadget.R +++ b/R/jsRepeatedGadget.R @@ -369,17 +369,17 @@ jsRepeatedGadjet <- function(data, nfactor.limit = 20) { out <- out[get(input$var_subset[[v]]) %in% input[[paste0("val_subset", v)]]] #var.factor <- c(data()$factor_original, input$factor_vname) out[, (var.factor) := lapply(.SD, factor), .SDcols = var.factor] - out.label2 <- mk.lev(out)[, c("variable", "class", "level")] - data.table::setkey(out.label, "variable", "class", "level") - data.table::setkey(out.label2, "variable", "class", "level") + out.label2 <- mk.lev(out)[, c("variable", "level")] + data.table::setkey(out.label, "variable", "level") + data.table::setkey(out.label2, "variable", "level") out.label <- out.label[out.label2] } else{ out <- out[get(input$var_subset[[v]]) >= input[[paste0("val_subset", v)]][1] & get(input$var_subset[[v]]) <= input[[paste0("val_subset", v)]][2]] #var.factor <- c(data()$factor_original, input$factor_vname) out[, (var.factor) := lapply(.SD, factor), .SDcols = var.factor] - out.label2 <- mk.lev(out)[, c("variable", "class", "level")] - data.table::setkey(out.label, "variable", "class", "level") - data.table::setkey(out.label2, "variable", "class", "level") + out.label2 <- mk.lev(out)[, c("variable", "level")] + data.table::setkey(out.label, "variable", "level") + data.table::setkey(out.label2, "variable", "level") out.label <- out.label[out.label2] } } diff --git a/R/jsSurveyGadget.R b/R/jsSurveyGadget.R index 38d35b00..335f2521 100644 --- a/R/jsSurveyGadget.R +++ b/R/jsSurveyGadget.R @@ -442,9 +442,9 @@ jsSurveyGadget <- function(data, nfactor.limit = 20) { # error = function(e){return(survey::svydesign(id = cluster.survey, strata = strata.survey, weights = weights.survey, data = out, nest = T))}) #var.factor <- c(data()$factor_original, input$factor_vname) out[, (var.factor) := lapply(.SD, factor), .SDcols = var.factor] - out.label2 <- mk.lev(out)[, c("variable", "class", "level")] - data.table::setkey(out.label, "variable", "class", "level") - data.table::setkey(out.label2, "variable", "class", "level") + out.label2 <- mk.lev(out)[, c("variable", "level")] + data.table::setkey(out.label, "variable", "level") + data.table::setkey(out.label2, "variable", "level") out.label <- out.label[out.label2] } else{ out <- out[get(input$var_subset[[v]]) >= input[[paste0("val_subset", v)]][1] & get(input$var_subset[[v]]) <= input[[paste0("val_subset", v)]][2]] @@ -454,9 +454,9 @@ jsSurveyGadget <- function(data, nfactor.limit = 20) { #var.factor <- c(data()$factor_original, input$factor_vname) out[, (var.factor) := lapply(.SD, factor), .SDcols = var.factor] - out.label2 <- mk.lev(out)[, c("variable", "class", "level")] - data.table::setkey(out.label, "variable", "class", "level") - data.table::setkey(out.label2, "variable", "class", "level") + out.label2 <- mk.lev(out)[, c("variable", "level")] + data.table::setkey(out.label, "variable", "level") + data.table::setkey(out.label2, "variable", "level") out.label <- out.label[out.label2] } } diff --git a/R/kaplan.R b/R/kaplan.R index 91de5dee..f4308494 100644 --- a/R/kaplan.R +++ b/R/kaplan.R @@ -447,9 +447,9 @@ kaplanModule <- function(input, output, session, data, data_label, data_varStruc } data.km[, (vlist()$factor_vars) := lapply(.SD, factor), .SDcols = vlist()$factor_vars] - label.regress2 <- mk.lev(data.km)[, c("variable", "class", "level")] - data.table::setkey(data_label(), "variable", "class", "level") - data.table::setkey(label.regress2, "variable", "class", "level") + label.regress2 <- mk.lev(data.km)[, c("variable", "level")] + data.table::setkey(data_label(), "variable", "level") + data.table::setkey(label.regress2, "variable", "level") label.regress <- data_label()[label.regress2] data.km[[input$event_km]] <- as.numeric(as.vector(data.km[[input$event_km]])) diff --git a/R/regress.R b/R/regress.R index 0a275bba..55fcd5ea 100644 --- a/R/regress.R +++ b/R/regress.R @@ -352,9 +352,9 @@ regressModule2 <- function(input, output, session, data, data_label, data_varStr } data.regress[, (vlist()$factor_vars) := lapply(.SD, factor), .SDcols = vlist()$factor_vars] - label.regress2 <- mk.lev(data.regress)[, c("variable", "class", "level")] - data.table::setkey(data_label(), "variable", "class", "level") - data.table::setkey(label.regress2, "variable", "class", "level") + label.regress2 <- mk.lev(data.regress)[, c("variable", "level")] + data.table::setkey(data_label(), "variable", "level") + data.table::setkey(label.regress2, "variable", "level") label.regress <- data_label()[label.regress2] } mf <- model.frame(form, data.regress) diff --git a/R/roc.R b/R/roc.R index 3beb8131..c43f7a23 100644 --- a/R/roc.R +++ b/R/roc.R @@ -500,9 +500,9 @@ rocModule <- function(input, output, session, data, data_label, data_varStruct = data.roc[, (vlist()$factor_vars) := lapply(.SD, factor), .SDcols = vlist()$factor_vars] - label.regress2 <- mk.lev(data.roc)[, c("variable", "class", "level")] - data.table::setkey(data_label(), "variable", "class", "level") - data.table::setkey(label.regress2, "variable", "class", "level") + label.regress2 <- mk.lev(data.roc)[, c("variable", "level")] + data.table::setkey(data_label(), "variable", "level") + data.table::setkey(label.regress2, "variable", "level") label.regress <- data_label()[label.regress2] data.roc[[input$event_roc]] <- as.numeric(as.vector(data.roc[[input$event_roc]])) } diff --git a/R/scatter.R b/R/scatter.R index f61dfe90..d0b4e2c8 100644 --- a/R/scatter.R +++ b/R/scatter.R @@ -227,9 +227,9 @@ scatterServer <- function(id, data, data_label, data_varStruct = NULL, nfactor.l } data[, (vlist()$factor_vars) := lapply(.SD, factor), .SDcols = vlist()$factor_vars] - label2 <- mk.lev(data)[, c("variable", "class", "level")] - data.table::setkey(label, "variable", "class", "level") - data.table::setkey(label2, "variable", "class", "level") + label2 <- mk.lev(data)[, c("variable", "level")] + data.table::setkey(label, "variable", "level") + data.table::setkey(label2, "variable", "level") label <- label[label2] } diff --git a/R/timeroc.R b/R/timeroc.R index 9d2d35c2..dadeb6e0 100644 --- a/R/timeroc.R +++ b/R/timeroc.R @@ -541,9 +541,9 @@ timerocModule <- function(input, output, session, data, data_label, data_varStru } } data.km[, (vlist()$factor_vars) := lapply(.SD, factor), .SDcols = vlist()$factor_vars] - label.regress2 <- mk.lev(data.km)[, c("variable", "class", "level")] - data.table::setkey(data_label(), "variable", "class", "level") - data.table::setkey(label.regress2, "variable", "class", "level") + label.regress2 <- mk.lev(data.km)[, c("variable", "level")] + data.table::setkey(data_label(), "variable", "level") + data.table::setkey(label.regress2, "variable", "level") label.regress <- data_label()[label.regress2] data.km[[input$event_km]] <- as.numeric(as.vector(data.km[[input$event_km]])) }