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 73e8939abda420198b2a4c5a99f5d8d6fdff19a9..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)
@@ -71,31 +71,38 @@ parser <- add_argument(parser, "--outfile", help='output file', default='example
 parser <- add_argument(parser, "--y_explained_variance", help='what proportion of the variance of y can be explained?', default=0.05)
 # parser <- add_argument(parser, "--zx_explained_variance", help='what proportion of the variance of x can be explained by z?', default=0.3)
 parser <- add_argument(parser, "--prediction_accuracy", help='how accurate is the predictive model?', default=0.73)
-parser <- add_argument(parser, "--Bzx", help='coefficient of z on x?', default=1)
-args <- parse_args(parser)
+parser <- add_argument(parser, "--outcome_formula", help='formula for the outcome variable', default="y~x+z")
+parser <- add_argument(parser, "--proxy_formula", help='formula for the proxy variable', default="w_pred~x")
+
+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 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
-Bxy <- 0.3
-Bzy <- -0.3
+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,'Bzy'=Bzy, 'Bzx'=Bzx, 'seed'=args$seed, 'y_explained_variance' = args$y_explained_variance, 'zx_explained_variance' = args$zx_explained_variance, "prediction_accuracy"=args$prediction_accuracy, "error"="")
-
-    outline <- run_simulation(df, result)
+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)
+