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)
 #### 
 
-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)
-    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)
-    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)
@@ -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, "--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
+Px <- args$Px
 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)
+