Skip to content

Commit

Permalink
use anyNA + use more r for dil asym
Browse files Browse the repository at this point in the history
  • Loading branch information
@christopherkenny
christopherkenny committed Jun 6, 2024
1 parent 7022362 commit 8ee1546
Show file tree
Hide file tree
Showing 5 changed files with 36 additions and 78 deletions.
4 changes: 0 additions & 4 deletions R/RcppExports.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -57,10 +57,6 @@ effgap <- function(dcounts, rcounts, totvote) {
.Call(`_redistmetrics_effgap`, dcounts, rcounts, totvote)
}

dil_asym <- function(dcounts, rcounts, dvote, rvote) {
.Call(`_redistmetrics_dil_asym`, dcounts, rcounts, dvote, rvote)
}

taugap <- function(tau, dvs, dseat_vec, nd) {
.Call(`_redistmetrics_taugap`, tau, dvs, dseat_vec, nd)
}
Expand Down
65 changes: 34 additions & 31 deletions R/partisan.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -31,10 +31,10 @@ part_bias <- function(plans, shp, dvote, rvote, v = 0.5) {
dvote <- rlang::eval_tidy(rlang::enquo(dvote), shp)
rvote <- rlang::eval_tidy(rlang::enquo(rvote), shp)

if (any(is.na(dvote))) {
if (anyNA(dvote)) {
cli::cli_abort('{.val NA} in argument to {.arg dvote}.')
}
if (any(is.na(rvote))) {
if (anyNA(rvote)) {
cli::cli_abort('{.val NA} in argument to {.arg rvote}.')
}
if (length(rvote) != nrow(plans)) {
Expand Down Expand Up @@ -80,10 +80,10 @@ part_dseats <- function(plans, shp, dvote, rvote) {
dvote <- rlang::eval_tidy(rlang::enquo(dvote), shp)
rvote <- rlang::eval_tidy(rlang::enquo(rvote), shp)

if (any(is.na(dvote))) {
if (anyNA(dvote)) {
cli::cli_abort('{.val NA} in argument to {.arg dvote}.')
}
if (any(is.na(rvote))) {
if (anyNA(rvote)) {
cli::cli_abort('{.val NA} in argument to {.arg rvote}.')
}
if (length(rvote) != nrow(plans)) {
Expand Down Expand Up @@ -130,10 +130,10 @@ part_dvs <- function(plans, shp, dvote, rvote) {
dvote <- rlang::eval_tidy(rlang::enquo(dvote), shp)
rvote <- rlang::eval_tidy(rlang::enquo(rvote), shp)

if (any(is.na(dvote))) {
if (anyNA(dvote)) {
cli::cli_abort('{.val NA} in argument to {.arg dvote}.')
}
if (any(is.na(rvote))) {
if (anyNA(rvote)) {
cli::cli_abort('{.val NA} in argument to {.arg rvote}.')
}
if (length(rvote) != nrow(plans)) {
Expand Down Expand Up @@ -182,10 +182,10 @@ part_egap <- function(plans, shp, dvote, rvote) {
dvote <- rlang::eval_tidy(rlang::enquo(dvote), shp)
rvote <- rlang::eval_tidy(rlang::enquo(rvote), shp)

if (any(is.na(dvote))) {
if (anyNA(dvote)) {
cli::cli_abort('{.val NA} in argument to {.arg dvote}.')
}
if (any(is.na(rvote))) {
if (anyNA(rvote)) {
cli::cli_abort('{.val NA} in argument to {.arg rvote}.')
}
if (length(rvote) != nrow(plans)) {
Expand Down Expand Up @@ -235,10 +235,10 @@ part_egap_ep <- function(plans, shp, dvote, rvote) {
dvote <- rlang::eval_tidy(rlang::enquo(dvote), shp)
rvote <- rlang::eval_tidy(rlang::enquo(rvote), shp)

if (any(is.na(dvote))) {
if (anyNA(dvote)) {
cli::cli_abort('{.val NA} in argument to {.arg dvote}.')
}
if (any(is.na(rvote))) {
if (anyNA(rvote)) {
cli::cli_abort('{.val NA} in argument to {.arg rvote}.')
}
if (length(rvote) != nrow(plans)) {
Expand Down Expand Up @@ -289,10 +289,10 @@ part_tau_gap <- function(plans, shp, dvote, rvote, tau = 1) {
dvote <- rlang::eval_tidy(rlang::enquo(dvote), shp)
rvote <- rlang::eval_tidy(rlang::enquo(rvote), shp)

if (any(is.na(dvote))) {
if (anyNA(dvote)) {
cli::cli_abort('{.val NA} in argument to {.arg dvote}.')
}
if (any(is.na(rvote))) {
if (anyNA(rvote)) {
cli::cli_abort('{.val NA} in argument to {.arg rvote}.')
}
if (length(rvote) != nrow(plans)) {
Expand Down Expand Up @@ -343,10 +343,10 @@ part_dil_asym <- function(plans, shp, dvote, rvote) {
dvote <- rlang::eval_tidy(rlang::enquo(dvote), shp)
rvote <- rlang::eval_tidy(rlang::enquo(rvote), shp)

if (any(is.na(dvote))) {
if (anyNA(dvote)) {
cli::cli_abort('{.val NA} in argument to {.arg dvote}.')
}
if (any(is.na(rvote))) {
if (anyNA(rvote)) {
cli::cli_abort('{.val NA} in argument to {.arg rvote}.')
}
if (length(rvote) != nrow(plans)) {
Expand All @@ -357,12 +357,15 @@ part_dil_asym <- function(plans, shp, dvote, rvote) {
}

nd <- length(unique(plans[, 1]))
tot_rvote <- sum(rvote)
tot_dvote <- sum(dvote)
rcounts <- agg_p2d(vote = rvote, dm = plans, nd = nd)
dcounts <- agg_p2d(vote = dvote, dm = plans, nd = nd)
half <- floor((rcounts + dcounts) / 2) + 1

rep(dil_asym(dcounts = dcounts, rcounts = rcounts, rvote = tot_rvote, dvote = tot_dvote), each = nd)
waste_dem <- matrix(ifelse(rcounts > dcounts, dcounts, dcounts - half), nrow = nd)
waste_rep <- matrix(ifelse(dcounts > rcounts, rcounts, rcounts - half), nrow = nd)

dil <- (colSums(waste_dem) / colSums(dcounts)) - (colSums(waste_rep) / colSums(rcounts))
rep(dil, each = nd)
}

#' Calculate Mean Median Score
Expand Down Expand Up @@ -398,10 +401,10 @@ part_mean_median <- function(plans, shp, dvote, rvote) {
dvote <- rlang::eval_tidy(rlang::enquo(dvote), shp)
rvote <- rlang::eval_tidy(rlang::enquo(rvote), shp)

if (any(is.na(dvote))) {
if (anyNA(dvote)) {
cli::cli_abort('{.val NA} in argument to {.arg dvote}.')
}
if (any(is.na(rvote))) {
if (anyNA(rvote)) {
cli::cli_abort('{.val NA} in argument to {.arg rvote}.')
}
if (length(rvote) != nrow(plans)) {
Expand Down Expand Up @@ -452,10 +455,10 @@ part_decl <- function(plans, shp, dvote, rvote, normalize = TRUE, adjust = TRUE)
dvote <- rlang::eval_tidy(rlang::enquo(dvote), shp)
rvote <- rlang::eval_tidy(rlang::enquo(rvote), shp)

if (any(is.na(dvote))) {
if (anyNA(dvote)) {
cli::cli_abort('{.val NA} in argument to {.arg dvote}.')
}
if (any(is.na(rvote))) {
if (anyNA(rvote)) {
cli::cli_abort('{.val NA} in argument to {.arg rvote}.')
}
if (length(rvote) != nrow(plans)) {
Expand Down Expand Up @@ -516,10 +519,10 @@ part_decl_simple <- function(plans, shp, dvote, rvote) {
dvote <- rlang::eval_tidy(rlang::enquo(dvote), shp)
rvote <- rlang::eval_tidy(rlang::enquo(rvote), shp)

if (any(is.na(dvote))) {
if (anyNA(dvote)) {
cli::cli_abort('{.val NA} in argument to {.arg dvote}.')
}
if (any(is.na(rvote))) {
if (anyNA(rvote)) {
cli::cli_abort('{.val NA} in argument to {.arg rvote}.')
}
if (length(rvote) != nrow(plans)) {
Expand Down Expand Up @@ -574,10 +577,10 @@ part_resp <- function(plans, shp, dvote, rvote, v = 0.5, bandwidth = 0.01) {
dvote <- rlang::eval_tidy(rlang::enquo(dvote), shp)
rvote <- rlang::eval_tidy(rlang::enquo(rvote), shp)

if (any(is.na(dvote))) {
if (anyNA(dvote)) {
cli::cli_abort('{.val NA} in argument to {.arg dvote}.')
}
if (any(is.na(rvote))) {
if (anyNA(rvote)) {
cli::cli_abort('{.val NA} in argument to {.arg rvote}.')
}
if (length(rvote) != nrow(plans)) {
Expand Down Expand Up @@ -627,10 +630,10 @@ part_lop_wins <- function(plans, shp, dvote, rvote) {
dvote <- rlang::eval_tidy(rlang::enquo(dvote), shp)
rvote <- rlang::eval_tidy(rlang::enquo(rvote), shp)

if (any(is.na(dvote))) {
if (anyNA(dvote)) {
cli::cli_abort('{.val NA} in argument to {.arg dvote}.')
}
if (any(is.na(rvote))) {
if (anyNA(rvote)) {
cli::cli_abort('{.val NA} in argument to {.arg rvote}.')
}
if (length(rvote) != nrow(plans)) {
Expand Down Expand Up @@ -681,10 +684,10 @@ part_rmd <- function(plans, shp, dvote, rvote) {
dvote <- rlang::eval_tidy(rlang::enquo(dvote), shp)
rvote <- rlang::eval_tidy(rlang::enquo(rvote), shp)

if (any(is.na(dvote))) {
if (anyNA(dvote)) {
cli::cli_abort('{.val NA} in argument to {.arg dvote}.')
}
if (any(is.na(rvote))) {
if (anyNA(rvote)) {
cli::cli_abort('{.val NA} in argument to {.arg rvote}.')
}
if (length(rvote) != nrow(plans)) {
Expand Down Expand Up @@ -734,10 +737,10 @@ part_sscd <- function(plans, shp, dvote, rvote) {
dvote <- rlang::eval_tidy(rlang::enquo(dvote), shp)
rvote <- rlang::eval_tidy(rlang::enquo(rvote), shp)

if (any(is.na(dvote))) {
if (anyNA(dvote)) {
cli::cli_abort('{.val NA} in argument to {.arg dvote}.')
}
if (any(is.na(rvote))) {
if (anyNA(rvote)) {
cli::cli_abort('{.val NA} in argument to {.arg rvote}.')
}
if (length(rvote) != nrow(plans)) {
Expand Down
4 changes: 2 additions & 2 deletions R/splits.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -155,7 +155,7 @@ splits_count <- function(plans, shp, admin) {
if (is.null(admin)) {
cli::cli_abort('{.arg admin} not found in {.arg shp}.')
}
if (any(is.na(admin))) {
if (anyNA(admin)) {
cli::cli_abort(c('{.arg admin} may not contain {.val NA}.',
i = 'Consider using {.fn splits_sub_count} instead.'))
}
Expand Down Expand Up @@ -213,7 +213,7 @@ splits_sub_count <- function(plans, shp, sub_admin) {
}
nc <- vctrs::vec_unique_count(sub_admin)

if (any(is.na(sub_admin))) {
if (anyNA(sub_admin)) {
admin_splits_count(plans, sub_admin, nd, nc)[-max(sub_admin), ] |>
`rownames<-`(value = stats::na.omit(row_names))
} else {
Expand Down
14 changes: 0 additions & 14 deletions src/RcppExports.cpp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -232,19 +232,6 @@ BEGIN_RCPP
return rcpp_result_gen;
END_RCPP
}
// dil_asym
NumericVector dil_asym(NumericMatrix dcounts, NumericMatrix rcounts, int dvote, int rvote);
RcppExport SEXP _redistmetrics_dil_asym(SEXP dcountsSEXP, SEXP rcountsSEXP, SEXP dvoteSEXP, SEXP rvoteSEXP) {
BEGIN_RCPP
Rcpp::RObject rcpp_result_gen;
Rcpp::traits::input_parameter< NumericMatrix >::type dcounts(dcountsSEXP);
Rcpp::traits::input_parameter< NumericMatrix >::type rcounts(rcountsSEXP);
Rcpp::traits::input_parameter< int >::type dvote(dvoteSEXP);
Rcpp::traits::input_parameter< int >::type rvote(rvoteSEXP);
rcpp_result_gen = Rcpp::wrap(dil_asym(dcounts, rcounts, dvote, rvote));
return rcpp_result_gen;
END_RCPP
}
// taugap
NumericVector taugap(double tau, NumericMatrix dvs, IntegerVector dseat_vec, int nd);
RcppExport SEXP _redistmetrics_taugap(SEXP tauSEXP, SEXP dvsSEXP, SEXP dseat_vecSEXP, SEXP ndSEXP) {
Expand Down Expand Up @@ -571,7 +558,6 @@ static const R_CallMethodDef CallEntries[] = {
{"_redistmetrics_DVS", (DL_FUNC) &_redistmetrics_DVS, 2},
{"_redistmetrics_effgapEP", (DL_FUNC) &_redistmetrics_effgapEP, 3},
{"_redistmetrics_effgap", (DL_FUNC) &_redistmetrics_effgap, 3},
{"_redistmetrics_dil_asym", (DL_FUNC) &_redistmetrics_dil_asym, 4},
{"_redistmetrics_taugap", (DL_FUNC) &_redistmetrics_taugap, 4},
{"_redistmetrics_meanmedian", (DL_FUNC) &_redistmetrics_meanmedian, 1},
{"_redistmetrics_declination_simple", (DL_FUNC) &_redistmetrics_declination_simple, 3},
Expand Down
27 changes: 0 additions & 27 deletions src/partisan.cpp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -98,33 +98,6 @@ NumericVector effgap(NumericMatrix dcounts, NumericMatrix rcounts, int totvote){
return eg;
}

// [[Rcpp::export(rng = false)]]
NumericVector dil_asym(NumericMatrix dcounts, NumericMatrix rcounts, int dvote, int rvote){
NumericVector eg(dcounts.ncol());

NumericMatrix dwaste(dcounts.nrow(), dcounts.ncol());
NumericMatrix rwaste(rcounts.nrow(), rcounts.ncol());
int minwin;
for(int c = 0; c < dcounts.ncol(); c++){
for(int r = 0; r < dcounts.nrow(); r++){
minwin = floor((dcounts(r,c) + rcounts(r,c))/2.0)+1;
if(dcounts(r,c) > rcounts(r,c)){
dwaste(r,c) += (dcounts(r,c) - minwin);
rwaste(r,c) += rcounts(r,c);
} else{
dwaste(r,c) += dcounts(r,c);
rwaste(r,c) += (rcounts(r,c) - minwin);
}
}
}

NumericVector dilasym(dcounts.ncol());
dilasym = (colSums(dwaste) / (double) dvote) - (colSums(rwaste) / (double) rvote);

return dilasym;
}


// [[Rcpp::export(rng = false)]]
NumericVector taugap(double tau, NumericMatrix dvs, IntegerVector dseat_vec, int nd){
NumericMatrix ai_mat = NumericMatrix(dvs.nrow(), dvs.ncol());
Expand Down

0 comments on commit 8ee1546

Please sign in to comment.