groceryheist/ml_measurement_error_public
1
0
Fork 0
Code

pass through optimization parameters

Browse Source
This commit is contained in:
Nathan TeBlunthuis 2023-03-01 10:39:35 -08:00
parent c1dbbfd0dd
commit ce6d12d4e6
1 changed files with 6 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
simulations/measerr_methods.R
View File

@ -23,7 +23,7 @@ likelihood.logistic <- function(model.params, outcome, model.matrix){
} }
## outcome_formula <- y ~ x + z; proxy_formula <- w_pred ~ y + x + z + x:z + x:y + z:y ## outcome_formula <- y ~ x + z; proxy_formula <- w_pred ~ y + x + z + x:z + x:y + z:y
measerr_mle_dv <- function(df, outcome_formula, outcome_family=binomial(link='logit'), proxy_formula, proxy_family=binomial(link='logit'),method='optim'){ measerr_mle_dv <- function(df, outcome_formula, outcome_family=binomial(link='logit'), proxy_formula, proxy_family=binomial(link='logit'),maxit=1e6, method='optim'){
df.obs <- model.frame(outcome_formula, df) df.obs <- model.frame(outcome_formula, df)
proxy.model.matrix <- model.matrix(proxy_formula, df) proxy.model.matrix <- model.matrix(proxy_formula, df)
proxy.variable <- all.vars(proxy_formula)[1] proxy.variable <- all.vars(proxy_formula)[1]
@ -106,7 +106,7 @@ measerr_mle_dv <- function(df, outcome_formula, outcome_family=binomial(link='lo
names(start) <- params names(start) <- params
if(method=='optim'){ if(method=='optim'){
fit <- optim(start, fn = nll, lower=lower, method='L-BFGS-B', hessian=TRUE, control=list(maxit=1e6)) fit <- optim(start, fn = nll, lower=lower, method=optim_method, hessian=TRUE, control=list(maxit=maxit))
} else { } else {
quoted.names <- gsub("[\\(\\)]",'',names(start)) quoted.names <- gsub("[\\(\\)]",'',names(start))
print(quoted.names) print(quoted.names)
@ -115,13 +115,13 @@ measerr_mle_dv <- function(df, outcome_formula, outcome_family=binomial(link='lo
measerr_mle_nll <- eval(parse(text=text)) measerr_mle_nll <- eval(parse(text=text))
names(start) <- quoted.names names(start) <- quoted.names
names(lower) <- quoted.names names(lower) <- quoted.names
fit <- mle2(minuslogl=measerr_mle_nll, start=start, lower=lower, parnames=params,control=list(maxit=1e6),method='L-BFGS-B') fit <- mle2(minuslogl=measerr_mle_nll, start=start, lower=lower, parnames=params,control=list(maxit=maxit),method=optim_method)
} }
return(fit) return(fit)
} }
measerr_mle <- function(df, outcome_formula, outcome_family=gaussian(), proxy_formula, proxy_family=binomial(link='logit'), truth_formula, truth_family=binomial(link='logit'),method='optim'){ measerr_mle <- function(df, outcome_formula, outcome_family=gaussian(), proxy_formula, proxy_family=binomial(link='logit'), truth_formula, truth_family=binomial(link='logit'),method='optim', maxit=1e6, optim_method='L-BFGS-B'){
df.obs <- model.frame(outcome_formula, df) df.obs <- model.frame(outcome_formula, df)
response.var <- all.vars(outcome_formula)[1] response.var <- all.vars(outcome_formula)[1]
@ -240,7 +240,7 @@ measerr_mle <- function(df, outcome_formula, outcome_family=gaussian(), proxy_fo
names(start) <- params names(start) <- params
if(method=='optim'){ if(method=='optim'){
fit <- optim(start, fn = measerr_mle_nll, lower=lower, method='L-BFGS-B', hessian=TRUE, control=list(maxit=1e6)) fit <- optim(start, fn = measerr_mle_nll, lower=lower, method=optim_method, hessian=TRUE, control=list(maxit=maxit))
} else { # method='mle2' } else { # method='mle2'
quoted.names <- gsub("[\\(\\)]",'',names(start)) quoted.names <- gsub("[\\(\\)]",'',names(start))
@ -250,7 +250,7 @@ measerr_mle <- function(df, outcome_formula, outcome_family=gaussian(), proxy_fo
measerr_mle_nll_mle <- eval(parse(text=text)) measerr_mle_nll_mle <- eval(parse(text=text))
names(start) <- quoted.names names(start) <- quoted.names
names(lower) <- quoted.names names(lower) <- quoted.names
fit <- mle2(minuslogl=measerr_mle_nll_mle, start=start, lower=lower, parnames=params,control=list(maxit=1e6),method='L-BFGS-B') fit <- mle2(minuslogl=measerr_mle_nll_mle, start=start, lower=lower, parnames=params,control=list(maxit=maxit),method=optim_method)
} }
return(fit) return(fit)