From 94081521ba5eec2156d0b616dba9d48a2920cb53 Mon Sep 17 00:00:00 2001 From: ConnorDonegan Date: Fri, 20 Oct 2023 16:53:37 -0500 Subject: [PATCH] avoid duplicates in standata --- .Rbuildignore | 1 + R/stan_car.R | 9 ++- R/stan_sar.R | 4 +- tests/testthat/test-stan-sar.R~ | 114 -------------------------------- 4 files changed, 11 insertions(+), 117 deletions(-) delete mode 100644 tests/testthat/test-stan-sar.R~ diff --git a/.Rbuildignore b/.Rbuildignore index 6161c8da..eb2e3244 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -21,3 +21,4 @@ cran-comments.md ^CRAN-RELEASE$ ^doc$ ^Meta$ +^CRAN-SUBMISSION$ diff --git a/R/stan_car.R b/R/stan_car.R index f1a041c2..0a1567b8 100644 --- a/R/stan_car.R +++ b/R/stan_car.R @@ -339,7 +339,7 @@ stan_car <- function(formula, y = y, y_int = y_int, trials = rep(0, length(y)), - n = n, + #n = n, # getting n from car_parts, below input_offset = offset, has_re = has_re, n_ids = n_ids, @@ -381,7 +381,14 @@ stan_car <- function(formula, standata <- c(standata, empty_icar_data(n), empty_esf_data(n), empty_sar_data(n)) ## ME MODEL ------------- me.list <- make_me_data(ME, xraw) + + # remove ME-car parts: othwerise, they duplicate the car_parts argument + duplicates <- c("n", "nC", "nAx_w", "C", "Delta_inv", "log_det_Delta_inv", "Ax_w", "Ax_v", "Ax_u", "Cidx", "lambda", "WCAR") + me.list[which(names(me.list) %in% duplicates)] <- NULL + + # append me.list to standata standata <- c(standata, me.list) + ## INTEGER OUTCOMES ------------- if (family$family == "binomial") { standata$y <- standata$y_int <- y[,1] diff --git a/R/stan_sar.R b/R/stan_sar.R index 8b54055f..8d913109 100644 --- a/R/stan_sar.R +++ b/R/stan_sar.R @@ -332,12 +332,12 @@ stan_sar <- function(formula, y = y, y_int = y_int, trials = rep(0, length(y)), - n = n, + #n = n, # getting n from sar_parts, below input_offset = offset, has_re = has_re, n_ids = n_ids, id = id_index$idx, - center_x = centerx, ####////!!!!#### + center_x = centerx, ## slx data ------------- W_w = as.array(W.list$w), W_v = as.array(W.list$v), diff --git a/tests/testthat/test-stan-sar.R~ b/tests/testthat/test-stan-sar.R~ deleted file mode 100644 index 49cf8093..00000000 --- a/tests/testthat/test-stan-sar.R~ +++ /dev/null @@ -1,114 +0,0 @@ -iter=10 -refresh = 0 -source("helpers.R") - -context("stan_sar") - -test_that("Poisson CAR model works", { - data(sentencing) - SW( - fit <- stan_car(sents ~ offset(log(expected_sents)), - data = sentencing, - car_parts = prep_car_data(shape2mat(sentencing, "B")), - chains = 1, - family = poisson(), - iter = iter, - refresh = refresh) - ) - expect_geostan(fit) -}) - -test_that("CAR accepts covariate ME", { - data(georgia) - SW( - fit <- stan_car(log(rate.male) ~ insurance + ICE, - data = georgia, - ME = prep_me_data(se = data.frame(insurance = georgia$insurance.se, - ICE = georgia$ICE.se) - ), - car_parts = prep_car_data(shape2mat(georgia, "B")), - chains = 1, - iter = iter, - refresh = refresh) - ) - expect_geostan(fit) -}) - -test_that("CAR accepts covariate ME with logit transform", { - data(georgia) - georgia$income <- georgia$income/1e3 - georgia$income.se <- georgia$income.se/1e3 - georgia$log_income <- log(georgia$income) - georgia$log_income.se <- se_log(georgia$income, georgia$income.se) - georgia$college <- georgia$college/1e3 - georgia$college.se <- georgia$college.se/1e3 - - ME <- prep_me_data(se = data.frame(college = georgia$college.se, - log_income = georgia$log_income.se), - logit = c(TRUE, FALSE), - bounds =c (0, Inf) - ) - SW( - fit <- stan_car(log(rate.male) ~ college + log_income, - data = georgia, - ME = ME, - car_parts = prep_car_data(shape2mat(georgia, "B")), - chains = 1, - iter = iter, - refresh = refresh) - ) - expect_geostan(fit) -}) - - -test_that("CAR accepts covariate ME with WX, mixed ME-non-ME", { - data(georgia) - A <- shape2mat(georgia) - cars <- prep_car_data(A) - ME <- prep_me_data(se = data.frame(insurance = georgia$insurance.se), - bounds = c(0, 100), - car_parts = cars) - SW( - fit <- stan_car(log(rate.male) ~ insurance + ICE, - slx = ~ insurance + ICE, - data = georgia, - ME = ME, - car_parts = cars, - chains = 1, - iter = iter, - refresh = refresh) - ) - expect_geostan(fit) -}) - -test_that("DCAR example runs", { - A <- shape2mat(georgia, "B") - D <- sf::st_distance(sf::st_centroid(georgia)) - A <- D * A - cp <- prep_car_data(A, "DCAR", k = 1) - fit <- stan_car(log(rate.male) ~ college, - data = georgia, - car = cp, - iter = iter, - chains = 1) - expect_geostan(fit) -}) - -test_that("CAR with censored y", { - data(georgia) - A <- shape2mat(georgia) - cars <- prep_car_data(A) - SW( - fit <- stan_car(deaths.female ~ offset(log(pop.at.risk.female)) + ICE + college, - censor_point = 9, - data = georgia, - chains = 1, - family = poisson(), - car_parts = cars, - iter = iter, - refresh = refresh - ) - ) - expect_geostan(fit) -}) -