Skip to content

Update helper_output_dataframe.R #3

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wwang93 wants to merge 26 commits into
base: master
Choose a base branch
from
Open

Update helper_output_dataframe.R #3

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
26 commits
Select commit Hold shift + click to select a range
d32fe06
Update helper_output_dataframe.R
wwang93 Nov 20, 2023
3cbab8b
Update helper_output_print.R
wwang93 Nov 20, 2023
4fc7208
Update helper_output_table.R
wwang93 Nov 20, 2023
eef4c49
Update helper_plot_correlation.R
wwang93 Nov 20, 2023
64e1584
Update helper_plot_threshold.R
wwang93 Nov 20, 2023
b0e5adc
Update konfound-glm-dichotomous.R
wwang93 Nov 20, 2023
68d4824
Update konfound-glm.R
wwang93 Nov 20, 2023
5fd0bca
Update konfound-lm.R
wwang93 Nov 20, 2023
e2a806b
Update konfound-lmer.R
wwang93 Nov 20, 2023
1c0d2b4
Update konfound.R
wwang93 Nov 20, 2023
4706575
Update mkonfound.R
wwang93 Nov 21, 2023
c4cc779
Update nonlinear_auxiliary.R
wwang93 Nov 21, 2023
50da8c9
Update pkonfound.R
wwang93 Nov 21, 2023
76eb2a6
Update test_cop.R
wwang93 Nov 21, 2023
b5e431d
Update test_pse.R
wwang93 Nov 21, 2023
91b6274
Update test_sensitivity.R
wwang93 Nov 21, 2023
c049eef
Update test_sensitivity_ln.R
wwang93 Nov 21, 2023
6991bf8
Update tkonfound.R
wwang93 Nov 21, 2023
1b9157e
Update tkonfound_fig.R
wwang93 Nov 21, 2023
96e340d
Update zzz.R
wwang93 Nov 21, 2023
c6b3a70
Update konfound.R
wwang93 Nov 21, 2023
4b6cafc
Update cop_pse_auxiliary.R
wwang93 Nov 21, 2023
49b6634
Update concord1.R
wwang93 Nov 21, 2023
39f3418
Update mkonfound-data.R
wwang93 Nov 21, 2023
5aedde0
Update tkonfound_fig.R
wwang93 Nov 21, 2023
2c42840
Update tkonfound_fig.R
wwang93 Nov 21, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
5 changes: 3 additions & 2 deletions R/concord1.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,7 @@
#'
#' @docType data
#' @name concord1
#' @references Hamilton, Lawrence C. 1983. Saving water: A causal model of household conservation. Sociological Perspectives 26(4):355-374.
#' @references Hamilton, Lawrence C. 1983. Saving water:
#' A causal model of household conservation. Sociological Perspectives 26(4):355-374.
#' @format A data.frame with 496 rows and 10 variables.
NULL
NULL
109 changes: 67 additions & 42 deletions R/cop_pse_auxiliary.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -21,9 +21,17 @@ cal_rxy <- function(ryxGz, rxz, ryz){
return(rxy)
}

cal_delta_star <- function(FR2max, R2, R2_uncond, est_eff, eff_thr, var_x, var_y, est_uncond, rxz, n_obs){
cal_delta_star <- function(FR2max,
R2, R2_uncond,
est_eff,
eff_thr,
var_x,
var_y,
est_uncond,
rxz,
n_obs){
if (FR2max > .99) {FR2max = .99}
# if (FR2max < R2 + inci) {FR2max = R2 + inci} check with Ken what this means
# if (FR2max < R2 + inci) {FR2max = R2 + inci}check with Ken what this means
if (FR2max > R2) {D = sqrt(FR2max - R2)}

#elements for computing Oster's delta_star
Expand All @@ -35,7 +43,8 @@ cal_delta_star <- function(FR2max, R2, R2_uncond, est_eff, eff_thr, var_x, var_y
t_x = var_x * (n_obs / (n_obs - 1)) * (1 - rxz^2)
## adjust df for var_x
## var_x is population variance, need sample variance from x
## this adjustment is to get closer to what robomit generates as they run regression using the sample data
## this adjustment is to get closer to what robomit generates as they
## run regression using the sample data
num1 = bt_m_b * rt_m_ro_t_syy * t_x
num2 = bt_m_b * var_x * t_x * b0_m_b1^2
num3 = 2 * bt_m_b^2 * (t_x * b0_m_b1 * var_x)
Expand Down Expand Up @@ -115,8 +124,8 @@ verify_reg_Gzcv = function(n_obs, sdx, sdy, sdz, sdcv,
flag_cov <- tryCatch(
expr = {
lavaan::sem(model,
sample.cov = cov.matrix,
sample.nobs = n_obs)
sample.cov = cov.matrix,
sample.nobs = n_obs)
},
error = function(e){
flag_cov = F
Expand All @@ -130,18 +139,24 @@ verify_reg_Gzcv = function(n_obs, sdx, sdy, sdz, sdcv,
#if model can be run to verify true delta, then run it can save results
if (class(flag_cov) == "lavaan") {
fit <- lavaan::sem(model,
sample.cov = cov.matrix,
sample.nobs = n_obs)
sample.cov = cov.matrix,
sample.nobs = n_obs)
## the R2 extracted from summary is NOT right, do the calculation below
R2 <- (sdy^2 - lavaan::parameterEstimates(fit)[4,]$est) / sdy^2
betaX <- lavaan::parameterEstimates(fit)[lavaan::parameterEstimates(fit)$label == 'beta1',]$est
seX <- lavaan::parameterEstimates(fit)[lavaan::parameterEstimates(fit)$label == 'beta1',]$se
betaZ <- lavaan::parameterEstimates(fit)[lavaan::parameterEstimates(fit)$label == 'beta2',]$est
seZ <- lavaan::parameterEstimates(fit)[lavaan::parameterEstimates(fit)$label == 'beta2',]$se
betaCV <- lavaan::parameterEstimates(fit)[lavaan::parameterEstimates(fit)$label == 'beta3',]$est
seCV <- lavaan::parameterEstimates(fit)[lavaan::parameterEstimates(fit)$label == 'beta3',]$se
betaX <- lavaan::parameterEstimates(fit)[
lavaan::parameterEstimates(fit)$label == 'beta1',]$est
seX <- lavaan::parameterEstimates(fit)[
lavaan::parameterEstimates(fit)$label == 'beta1',]$se
betaZ <- lavaan::parameterEstimates(fit)[
lavaan::parameterEstimates(fit)$label == 'beta2',]$est
seZ <- lavaan::parameterEstimates(fit)[
lavaan::parameterEstimates(fit)$label == 'beta2',]$se
betaCV <- lavaan::parameterEstimates(fit)[
lavaan::parameterEstimates(fit)$label == 'beta3',]$est
seCV <- lavaan::parameterEstimates(fit)[
lavaan::parameterEstimates(fit)$label == 'beta3',]$se
}

#get regression based on true delta in terms of standardized coefficent
cor.matrix <- matrix(c(1,rxy, rzy, rcvy,
rxy, 1, rxz, rcvx,
Expand All @@ -153,8 +168,8 @@ verify_reg_Gzcv = function(n_obs, sdx, sdy, sdz, sdcv,
flag_cor <- tryCatch(
expr = {
lavaan::sem(model,
sample.cov = cor.matrix,
sample.nobs = n_obs)
sample.cov = cor.matrix,
sample.nobs = n_obs)
},
error = function(e){
flag_cor = F
Expand All @@ -169,15 +184,21 @@ verify_reg_Gzcv = function(n_obs, sdx, sdy, sdz, sdcv,
# if model can be run, then run it
if (class(flag_cor) == "lavaan") {
fit <- lavaan::sem(model,
sample.cov = cor.matrix,
sample.nobs = n_obs)
sample.cov = cor.matrix,
sample.nobs = n_obs)
std_R2 <- 1 - lavaan::parameterEstimates(fit)[4,]$est
std_betaX <- lavaan::parameterEstimates(fit)[lavaan::parameterEstimates(fit)$label == 'beta1',]$est
std_seX <- lavaan::parameterEstimates(fit)[lavaan::parameterEstimates(fit)$label == 'beta1',]$se
std_betaZ <- lavaan::parameterEstimates(fit)[lavaan::parameterEstimates(fit)$label == 'beta2',]$est
std_seZ <- lavaan::parameterEstimates(fit)[lavaan::parameterEstimates(fit)$label == 'beta2',]$se
std_betaCV <- lavaan::parameterEstimates(fit)[lavaan::parameterEstimates(fit)$label == 'beta3',]$est
std_seCV <- lavaan::parameterEstimates(fit)[lavaan::parameterEstimates(fit)$label == 'beta3',]$se
std_betaX <- lavaan::parameterEstimates(fit)[
lavaan::parameterEstimates(fit)$label == 'beta1',]$est
std_seX <- lavaan::parameterEstimates(fit)[
lavaan::parameterEstimates(fit)$label == 'beta1',]$se
std_betaZ <- lavaan::parameterEstimates(fit)[
lavaan::parameterEstimates(fit)$label == 'beta2',]$est
std_seZ <- lavaan::parameterEstimates(fit)[
lavaan::parameterEstimates(fit)$label == 'beta2',]$se
std_betaCV <- lavaan::parameterEstimates(fit)[
lavaan::parameterEstimates(fit)$label == 'beta3',]$est
std_seCV <- lavaan::parameterEstimates(fit)[
lavaan::parameterEstimates(fit)$label == 'beta3',]$se
}

if (class(flag_cor) == "lavaan" && class(flag_cov) == "lavaan") {
Expand Down Expand Up @@ -247,8 +268,8 @@ verify_reg_Gz = function(n_obs, sdx, sdy, sdz, rxy, rxz, rzy){
flag_cov <- tryCatch(
expr = {
lavaan::sem(model,
sample.cov = cov.matrix,
sample.nobs = n_obs)
sample.cov = cov.matrix,
sample.nobs = n_obs)
},
error = function(e){
flag_cov = F
Expand All @@ -262,16 +283,20 @@ verify_reg_Gz = function(n_obs, sdx, sdy, sdz, rxy, rxz, rzy){
#if model can be run to verify true delta, then run it can save results
if (class(flag_cov) == "lavaan") {
fit <- lavaan::sem(model,
sample.cov = cov.matrix,
sample.nobs = n_obs)
sample.cov = cov.matrix,
sample.nobs = n_obs)
## the R2 extracted from summary is NOT right, do the calculation below
R2 <- (sdy^2 - lavaan::parameterEstimates(fit)[3,]$est) / sdy^2
betaX <- lavaan::parameterEstimates(fit)[lavaan::parameterEstimates(fit)$label == 'beta1',]$est
seX <- lavaan::parameterEstimates(fit)[lavaan::parameterEstimates(fit)$label == 'beta1',]$se
betaZ <- lavaan::parameterEstimates(fit)[lavaan::parameterEstimates(fit)$label == 'beta2',]$est
seZ <- lavaan::parameterEstimates(fit)[lavaan::parameterEstimates(fit)$label == 'beta2',]$se
}

betaX <- lavaan::parameterEstimates(fit)[
lavaan::parameterEstimates(fit)$label == 'beta1',]$est
seX <- lavaan::parameterEstimates(fit)[
lavaan::parameterEstimates(fit)$label == 'beta1',]$se
betaZ <- lavaan::parameterEstimates(fit)[
lavaan::parameterEstimates(fit)$label == 'beta2',]$est
seZ <- lavaan::parameterEstimates(fit)[
lavaan::parameterEstimates(fit)$label == 'beta2',]$se
}

if (class(flag_cov) == "lavaan") {
result = list(R2, betaX, seX, betaZ, seZ)
return(result)
Expand All @@ -294,8 +319,8 @@ verify_reg_uncond = function(n_obs, sdx, sdy, rxy){
flag_cov <- tryCatch(
expr = {
lavaan::sem(model,
sample.cov = cov.matrix,
sample.nobs = n_obs)
sample.cov = cov.matrix,
sample.nobs = n_obs)
},
error = function(e){
flag_cov = F
Expand All @@ -309,12 +334,14 @@ verify_reg_uncond = function(n_obs, sdx, sdy, rxy){
#if model can be run to verify true delta, then run it can save results
if (class(flag_cov) == "lavaan") {
fit <- lavaan::sem(model,
sample.cov = cov.matrix,
sample.nobs = n_obs)
sample.cov = cov.matrix,
sample.nobs = n_obs)
## the R2 extracted from summary is NOT right, do the calculation below
R2 <- (sdy^2 - lavaan::parameterEstimates(fit)[2,]$est) / sdy^2
betaX <- lavaan::parameterEstimates(fit)[lavaan::parameterEstimates(fit)$label == 'beta1',]$est
seX <- lavaan::parameterEstimates(fit)[lavaan::parameterEstimates(fit)$label == 'beta1',]$se
betaX <- lavaan::parameterEstimates(fit)[
lavaan::parameterEstimates(fit)$label == 'beta1',]$est
seX <- lavaan::parameterEstimates(fit)[
lavaan::parameterEstimates(fit)$label == 'beta1',]$se
}

if (class(flag_cov) == "lavaan") {
Expand All @@ -324,5 +351,3 @@ verify_reg_uncond = function(n_obs, sdx, sdy, rxy){
stop("Error!")
}
}


11 changes: 10 additions & 1 deletion R/helper_output_dataframe.R
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,6 +1,15 @@
# Function to output the data frame

output_df <- function(est_eff, beta_threshhold, unstd_beta, bias = NULL, sustain = NULL, recase, obs_r, critical_r, r_con, itcv, non_linear) {
output_df <- function(est_eff,
beta_threshhold,
unstd_beta,
bias = NULL,
sustain = NULL,
recase, obs_r,
critical_r,
r_con,
itcv,
non_linear) {
if (abs(est_eff) > abs(beta_threshhold)) {
df <- dplyr::tibble(
action = "to_invalidate",
Expand Down
Loading