Skip to content

Commit

Permalink
improve style of code with styler package
Browse files Browse the repository at this point in the history
  • Loading branch information
@LukaszChrostowski
LukaszChrostowski committed Dec 2, 2023
1 parent 59d3e7b commit 0a58f7c
Show file tree
Hide file tree
Showing 20 changed files with 3,286 additions and 2,855 deletions.
497 changes: 267 additions & 230 deletions R/EstimationMethods.R
View file

Large diffs are not rendered by default.

293 changes: 162 additions & 131 deletions R/OutcomeMethods.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -16,61 +16,70 @@ glm_nonprobsvy <- function(outcome,
model_frame,
vars_selection,
pop_totals) {

if(is.character(family_outcome)) {
if (is.character(family_outcome)) {
family_nonprobsvy <- paste(family_outcome, "_nonprobsvy", sep = "")
family_nonprobsvy <- get(family_nonprobsvy, mode = "function", envir = parent.frame())
family_nonprobsvy <- family_nonprobsvy()
}
if (vars_selection == FALSE) {
# Estimation for outcome model
model_out <- internal_outcome(outcome = outcome,
data = data,
weights = weights,
family_outcome = family_outcome,
start_outcome = start_outcome)
if (vars_selection == FALSE) {
# Estimation for outcome model
model_out <- internal_outcome(
outcome = outcome,
data = data,
weights = weights,
family_outcome = family_outcome,
start_outcome = start_outcome
)

model_nons_coefs <- model_out$glm$coefficients
parameters <- model_out$glm_summary$coefficients
model_nons_coefs <- model_out$glm$coefficients
parameters <- model_out$glm_summary$coefficients

if (is.null(pop_totals)) {
y_rand_pred <- stats::predict.glm(model_out$glm, newdata = model_frame, type = "response")
} else {
eta <- pop_totals %*% model_nons_coefs / pop_totals[1]
y_rand_pred <- family_nonprobsvy$linkinv(eta)
}
y_nons_pred <- model_out$glm$fitted.values
if (is.null(pop_totals)) {
y_rand_pred <- stats::predict.glm(model_out$glm, newdata = model_frame, type = "response")
} else {
model <- stats::glm.fit(x = X_nons,
y = y_nons,
weights = weights,
family = get_method(family_outcome),
start = start_outcome,
control = list(control$epsilon,
control$maxit,
control$trace),
intercept = FALSE)
model_summ <- stats::summary.glm(model)
parameters <- model_summ$coefficients
model_nons_coefs <- model$coefficients
if (is.null(pop_totals)) {
eta <- X_rand %*% model_nons_coefs
} else {
eta <- pop_totals %*% model_nons_coefs / pop_totals[1]
}
eta <- pop_totals %*% model_nons_coefs / pop_totals[1]
y_rand_pred <- family_nonprobsvy$linkinv(eta)
y_nons_pred <- model$fitted.values

model_out <- list(glm = model,
glm_summary = model_summ)
}
model_out$glm$std_err <- parameters[,2]
y_nons_pred <- model_out$glm$fitted.values
} else {
model <- stats::glm.fit(
x = X_nons,
y = y_nons,
weights = weights,
family = get_method(family_outcome),
start = start_outcome,
control = list(
control$epsilon,
control$maxit,
control$trace
),
intercept = FALSE
)
model_summ <- stats::summary.glm(model)
parameters <- model_summ$coefficients
model_nons_coefs <- model$coefficients
if (is.null(pop_totals)) {
eta <- X_rand %*% model_nons_coefs
} else {
eta <- pop_totals %*% model_nons_coefs / pop_totals[1]
}
y_rand_pred <- family_nonprobsvy$linkinv(eta)
y_nons_pred <- model$fitted.values

model_out <- list(
glm = model,
glm_summary = model_summ
)
}
model_out$glm$std_err <- parameters[, 2]
names(model_out$glm$std_err) <- names(model_out$glm$coefficients)

list(model = model_out$glm,
y_rand_pred = y_rand_pred,
y_nons_pred = y_nons_pred,
parameters = parameters)
list(
model = model_out$glm,
y_rand_pred = y_rand_pred,
y_nons_pred = y_nons_pred,
parameters = parameters
)
}

nn_nonprobsvy <- function(outcome,
Expand All @@ -88,53 +97,63 @@ nn_nonprobsvy <- function(outcome,
model_frame = NULL,
start_outcome = NULL) { # TODO consider add data standardization before modelling

model_nons <- nonprobMI_nn(data = X_nons,
query = X_nons,
k = control$k,
treetype = control$treetype,
searchtype = control$searchtype)
model_nons <- nonprobMI_nn(
data = X_nons,
query = X_nons,
k = control$k,
treetype = control$treetype,
searchtype = control$searchtype
)
if (is.null(pop_totals)) {
model_rand <- nonprobMI_nn(data = X_nons,
query = X_rand,
k = control$k,
treetype = control$treetype,
searchtype = control$searchtype)
model_rand <- nonprobMI_nn(
data = X_nons,
query = X_rand,
k = control$k,
treetype = control$treetype,
searchtype = control$searchtype
)
y_rand_pred <- vector(mode = "numeric", length = n_rand)
y_nons_pred <- vector(mode = "numeric", length = n_nons)
parameters <- "Non-parametric method for outcome model"

y_rand_pred <- apply(model_rand$nn.idx, 1,
FUN=\(x) mean(y_nons[x])
#FUN=\(x) mean(sample_nonprob$short_[x])
FUN = \(x) mean(y_nons[x])
# FUN=\(x) mean(sample_nonprob$short_[x])
)

y_nons_pred <- apply(model_nons$nn.idx, 1,
FUN=\(x) mean(y_nons[x])
#FUN=\(x) mean(sample_nonprob$short_[x])
FUN = \(x) mean(y_nons[x])
# FUN=\(x) mean(sample_nonprob$short_[x])
)
} else {
model_rand <- nonprobMI_nn(data = X_nons,
query = t(as.matrix(pop_totals / pop_totals[1])),
k = control$k,
treetype = control$treetype,
searchtype = control$searchtype)
model_rand <- nonprobMI_nn(
data = X_nons,
query = t(as.matrix(pop_totals / pop_totals[1])),
k = control$k,
treetype = control$treetype,
searchtype = control$searchtype
)
y_rand_pred <- vector(mode = "numeric", length = 1)
y_nons_pred <- vector(mode = "numeric", length = n_nons)
parameters <- "Non-parametric method for outcome model"

y_rand_pred <- mean(y_nons[model_rand$nn.idx])
y_nons_pred <- apply(model_nons$nn.idx, 1,
FUN=\(x) mean(y_nons[x])
#FUN=\(x) mean(sample_nonprob$short_[x])
FUN = \(x) mean(y_nons[x])
# FUN=\(x) mean(sample_nonprob$short_[x])
)
}

model_out <- list(model_nons = model_nons,
model_rand = model_rand)
list(model = model_out,
y_rand_pred = y_rand_pred,
y_nons_pred = y_nons_pred,
parameters = parameters)
model_out <- list(
model_nons = model_nons,
model_rand = model_rand
)
list(
model = model_out,
y_rand_pred = y_rand_pred,
y_nons_pred = y_nons_pred,
parameters = parameters
)
}

pmm_nonprobsvy <- function(outcome,
Expand All @@ -151,59 +170,69 @@ pmm_nonprobsvy <- function(outcome,
vars_selection,
pop_totals,
model_frame) {

glm_object <- glm_nonprobsvy(outcome,
data,
weights,
family_outcome,
start_outcome = start_outcome,
X_nons,
y_nons,
X_rand,
control,
n_nons,
n_rand,
model_frame,
vars_selection,
pop_totals)
data,
weights,
family_outcome,
start_outcome = start_outcome,
X_nons,
y_nons,
X_rand,
control,
n_nons,
n_rand,
model_frame,
vars_selection,
pop_totals
)

model_nons <- nonprobMI_nn(data = glm_object$y_nons_pred,
query = glm_object$y_nons_pred,
k = control$k,
treetype = control$treetype,
searchtype = control$searchtype)
model_nons <- nonprobMI_nn(
data = glm_object$y_nons_pred,
query = glm_object$y_nons_pred,
k = control$k,
treetype = control$treetype,
searchtype = control$searchtype
)

y_nons_pred <- apply(model_nons$nn.idx, 1,
FUN=\(x) mean(y_nons[x])
#FUN=\(x) mean(sample_nonprob$short_[x])
FUN = \(x) mean(y_nons[x])
# FUN=\(x) mean(sample_nonprob$short_[x])
)

if (is.null(pop_totals)) {
model_rand <- nonprobMI_nn(data = glm_object$y_nons_pred,
query = glm_object$y_rand_pred,
k = control$k,
treetype = control$treetype,
searchtype = control$searchtype)
model_rand <- nonprobMI_nn(
data = glm_object$y_nons_pred,
query = glm_object$y_rand_pred,
k = control$k,
treetype = control$treetype,
searchtype = control$searchtype
)

y_rand_pred <- apply(model_rand$nn.idx, 1,
FUN=\(x) mean(y_nons[x])
#FUN=\(x) mean(sample_nonprob$short_[x])
FUN = \(x) mean(y_nons[x])
# FUN=\(x) mean(sample_nonprob$short_[x])
)
} else {
model_rand <- nonprobMI_nn(data = glm_object$y_nons_pred,
query = glm_object$y_rand_pred,
k = control$k,
treetype = control$treetype,
searchtype = control$searchtype)
y_rand_pred <- mean(y_nons[model_rand$nn.idx])
} else {
model_rand <- nonprobMI_nn(
data = glm_object$y_nons_pred,
query = glm_object$y_rand_pred,
k = control$k,
treetype = control$treetype,
searchtype = control$searchtype
)
y_rand_pred <- mean(y_nons[model_rand$nn.idx])
}

model_out <- list(model_nons = model_nons,
model_rand = model_rand)
list(model = model_out,
y_rand_pred = y_rand_pred,
y_nons_pred = y_nons_pred,
parameters = glm_object$parameters)
model_out <- list(
model_nons = model_nons,
model_rand = model_rand
)
list(
model = model_out,
y_rand_pred = y_rand_pred,
y_nons_pred = y_nons_pred,
parameters = glm_object$parameters
)
}

nonprobMI_fit <- function(outcome,
Expand All @@ -217,7 +246,6 @@ nonprobMI_fit <- function(outcome,
model,
x,
y) {

family <- family_outcome

if (is.character(family)) {
Expand All @@ -227,14 +255,18 @@ nonprobMI_fit <- function(outcome,
family <- family()
}
data$weights <- weights # TODO just for now, find more efficient way
model_nons <- stats::glm(formula = outcome,
data = data,
weights = weights,
family = family,
start = start,
control = list(control_outcome$epsilon,
control_outcome$maxit,
control_outcome$trace))
model_nons <- stats::glm(
formula = outcome,
data = data,
weights = weights,
family = family,
start = start,
control = list(
control_outcome$epsilon,
control_outcome$maxit,
control_outcome$trace
)
)

model_nons
}
Expand All @@ -246,15 +278,14 @@ nonprobMI_nn <- function(data,
searchtype,
radius = 0,
eps = 0) {


model_nn <- RANN::nn2(data = data,
query = query,
k = k,
treetype = treetype,
searchtype = searchtype,
radius = radius,
eps = eps)
model_nn <- RANN::nn2(
data = data,
query = query,
k = k,
treetype = treetype,
searchtype = searchtype,
radius = radius,
eps = eps
)
model_nn
}

Loading

0 comments on commit 0a58f7c

Please sign in to comment.