Unstash work on misclassification models

[ml_measurement_error_public.git] / simulations / 01_two_covariates.R

diff --git a/simulations/01_two_covariates.R b/simulations/01_two_covariates.R
index 3fd6914d7b73d63c9b8bbbfd446eb69e1c92c60d..1f317be96eaa5ff9cd2803d06afde54e8d6f9f17 100644 (file)
--- a/simulations/01_two_covariates.R
+++ b/simulations/01_two_covariates.R
@@ -30,11 +30,11 @@ source("simulation_base.R")
 #### how much power do we get from the model in the first place? (sweeping N and m)
 #### 
 
 #### how much power do we get from the model in the first place? (sweeping N and m)
 #### 
 

-simulate_data <- function(N, m, B0=0, Bxy=0.2, Bzy=-0.2, Bzx=0.2, y_explained_variance=0.025, prediction_accuracy=0.73, seed=1){
+simulate_data <- function(N, m, B0=0, Bxy=0.2, Bzy=-0.2, Bzx=0.2, y_explained_variance=0.025, prediction_accuracy=0.73, Px=0.5, seed=1){

     set.seed(seed)
     set.seed(seed)

-    z <- rbinom(N, 1, 0.5)
+    z <- rnorm(N,sd=0.5)

                                         #    x.var.epsilon <- var(Bzx *z) * ((1-zx_explained_variance)/zx_explained_variance)
                                         #    x.var.epsilon <- var(Bzx *z) * ((1-zx_explained_variance)/zx_explained_variance)

-    xprime <- Bzx * z #+ x.var.epsilon
+    xprime <- Bzx * z + qlogis(Px)

     x <- rbinom(N,1,plogis(xprime))
 
     y.var.epsilon <- (var(Bzy * z) + var(Bxy *x) + 2*cov(Bxy*x,Bzy*z)) * ((1-y_explained_variance)/y_explained_variance)
     x <- rbinom(N,1,plogis(xprime))
 
     y.var.epsilon <- (var(Bzy * z) + var(Bxy *x) + 2*cov(Bxy*x,Bzy*z)) * ((1-y_explained_variance)/y_explained_variance)


@@ -77,31 +77,32 @@ parser <- add_argument(parser, "--proxy_formula", help='formula for the proxy va
 parser <- add_argument(parser, "--truth_formula", help='formula for the true variable', default="x~z")
 parser <- add_argument(parser, "--Bzx", help='Effect of z on x', default=0.3)
 parser <- add_argument(parser, "--Bzy", help='Effect of z on y', default=-0.3)
 parser <- add_argument(parser, "--truth_formula", help='formula for the true variable', default="x~z")
 parser <- add_argument(parser, "--Bzx", help='Effect of z on x', default=0.3)
 parser <- add_argument(parser, "--Bzy", help='Effect of z on y', default=-0.3)

-parser <- add_argument(parser, "--Bxy", help='Effect of z on y', default=0.3)
+parser <- add_argument(parser, "--Bxy", help='Effect of x on y', default=0.3)
+parser <- add_argument(parser, "--Px", help='Base rate of x', default=0.5)
+parser <- add_argument(parser, "--confint_method", help='method for approximating confidence intervals', default='quad')

 
 args <- parse_args(parser)
 B0 <- 0
 
 args <- parse_args(parser)
 B0 <- 0

+Px <- args$Px

 Bxy <- args$Bxy
 Bzy <- args$Bzy
 Bzx <- args$Bzx
 
 Bxy <- args$Bxy
 Bzy <- args$Bzy
 Bzx <- args$Bzx
 

-if (args$m < args$N){
+df <- simulate_data(args$N, args$m, B0, Bxy, Bzy, Bzx, Px, seed=args$seed + 500, y_explained_variance = args$y_explained_variance,  prediction_accuracy=args$prediction_accuracy)

 
 

-    df <- simulate_data(args$N, args$m, B0, Bxy, Bzy, Bzx, seed=args$seed + 500, y_explained_variance = args$y_explained_variance,  prediction_accuracy=args$prediction_accuracy)
+result <- list('N'=args$N,'m'=args$m,'B0'=B0,'Bxy'=Bxy, 'Bzx'=Bzx, 'Bzy'=Bzy, 'Px'=Px, 'seed'=args$seed, 'y_explained_variance'=args$y_explained_variance, 'prediction_accuracy'=args$prediction_accuracy, 'accuracy_imbalance_difference'=args$accuracy_imbalance_difference, 'outcome_formula'=args$outcome_formula, 'proxy_formula'=args$proxy_formula,truth_formula=args$truth_formula, confint_method=args$confint_method,error='')

 
 

-    result <- list('N'=args$N,'m'=args$m,'B0'=B0,'Bxy'=Bxy, Bzx=Bzx, 'Bzy'=Bzy, 'seed'=args$seed, 'y_explained_variance'=args$y_explained_variance, 'prediction_accuracy'=args$prediction_accuracy, 'accuracy_imbalance_difference'=args$accuracy_imbalance_difference, 'outcome_formula'=args$outcome_formula, 'proxy_formula'=args$proxy_formula,truth_formula=args$truth_formula, error='')
-
-    outline <- run_simulation(df, result, outcome_formula=as.formula(args$outcome_formula), proxy_formula=as.formula(args$proxy_formula), truth_formula=as.formula(args$truth_formula))
+outline <- run_simulation(df, result, outcome_formula=as.formula(args$outcome_formula), proxy_formula=as.formula(args$proxy_formula), truth_formula=as.formula(args$truth_formula),confint_method=args$confint_method)

     
     

-    outfile_lock <- lock(paste0(args$outfile, '_lock'),exclusive=TRUE)
-    if(file.exists(args$outfile)){
-        logdata <- read_feather(args$outfile)
-        logdata <- rbind(logdata,as.data.table(outline),fill=TRUE)
-    } else {
-        logdata <- as.data.table(outline)
-    }
-
-    print(outline)
-    write_feather(logdata, args$outfile)
-    unlock(outfile_lock)
+outfile_lock <- lock(paste0(args$outfile, '_lock'),exclusive=TRUE)
+if(file.exists(args$outfile)){
+    logdata <- read_feather(args$outfile)
+    logdata <- rbind(logdata,as.data.table(outline),fill=TRUE)
+} else {
+    logdata <- as.data.table(outline)

 }
 }

+
+print(outline)
+write_feather(logdata, args$outfile)
+unlock(outfile_lock)
+