R-Computing-Lab · smasongarrison · May 19, 2025 · May 5, 2025 · May 19, 2025 · May 19, 2025
diff --git a/NEWS.md b/NEWS.md
@@ -6,6 +6,8 @@
 * Vectorizing `discord_data()` to improve performance.
 * Adding tests to ensure comparability between optimized and non-optimized versions of `discord_data()`.
 * Adding `discord_between_model()` to get the between-family model
+* Added unique filter for `discord_data()` to ensure that the data is not duplicated.
+* Added tests for categorical variables in `discord_data()`.
 
 # discord 1.2.3.1
 * More mild improvements to documentation

diff --git a/R/func_discord_data.R b/R/func_discord_data.R
@@ -47,7 +47,7 @@ discord_data <- function(data,
                          fast = TRUE,
                          ...) {
   if (fast) {
-    discord_data_fast(
+    unique(discord_data_fast(
       data = data,
       outcome = outcome,
       id = id,
@@ -58,9 +58,9 @@ discord_data <- function(data,
       predictors = predictors,
       coding_method = coding_method,
       ...
-    )
+    ))
   } else {
-    discord_data_ram_optimized(
+    unique(discord_data_ram_optimized(
       data = data,
       outcome = outcome,
       id = id,
@@ -71,7 +71,7 @@ discord_data <- function(data,
       predictors = predictors,
       coding_method = coding_method,
       ...
-    )
+    ))
   }
 }
 

diff --git a/R/func_discord_regression.R b/R/func_discord_regression.R
@@ -28,8 +28,12 @@
                                data_processed = FALSE,
                                coding_method = "none",
                                fast = TRUE) {
+ if( data_processed == TRUE & !is.data.frame(data) ) {
+    stop("data must be a data frame if data_processed is TRUE")
+ }
+  if( data_processed == FALSE){
   check_discord_errors(data = data, id = id, sex = sex, race = race, pair_identifiers = pair_identifiers)
-
+}
   # if no demographics provided
   if (is.null(demographics)) {
     if (is.null(sex) & is.null(race)) {

diff --git a/R/func_kinsim.R b/R/func_kinsim.R
@@ -137,7 +137,7 @@ kinsim <- function(
       sigma_a[4, 1] <- cov_a * r_all[i]
       sigma_a[3, 2] <- cov_a * r_all[i]
       sigma_a[2, 3] <- cov_a * r_all[i]
-      A.r <- rmvn(n,
+      A.r <- .rmvn(n,
         sigma = sigma_a
       )
 
@@ -154,7 +154,7 @@ kinsim <- function(
       sigma_c[4, 1] <- cov_c * 1
       sigma_c[3, 2] <- cov_c * 1
       sigma_c[2, 3] <- cov_c * 1
-      C.r <- rmvn(n,
+      C.r <- .rmvn(n,
         sigma = sigma_c
       )
       C.r[, 1:2] <- C.r[, 1:2] * sC[1]
@@ -166,7 +166,7 @@ kinsim <- function(
       sigma_e[3, 1] <- cov_e
       sigma_e[2, 4] <- cov_e
       sigma_e[4, 2] <- cov_e
-      E.r <- rmvn(n,
+      E.r <- .rmvn(n,
         sigma = sigma_e
       )
       E.r[, 1:2] <- E.r[, 1:2] * sE[1]
@@ -225,7 +225,7 @@ kinsim <- function(
       sigma_a[3, 2] <- cov_a * r_val
       sigma_a[2, 3] <- cov_a * r_val
 
-      A_tmp <- rmvn(n_sub, sigma = sigma_a)
+      A_tmp <- .rmvn(n_sub, sigma = sigma_a)
 
       A.r[idx, 1:2] <- A_tmp[, 1:2] * sA[1]
       A.r[idx, 3:4] <- A_tmp[, 3:4] * sA[2]
@@ -241,7 +241,7 @@ kinsim <- function(
       sigma_c[3, 2] <- cov_c * 1
       sigma_c[2, 3] <- cov_c * 1
 
-      C_tmp <- rmvn(n_sub, sigma = sigma_c)
+      C_tmp <- .rmvn(n_sub, sigma = sigma_c)
       C.r[idx, 1:2] <- C_tmp[, 1:2] * sC[1]
       C.r[idx, 3:4] <- C_tmp[, 3:4] * sC[2]
 
@@ -252,7 +252,7 @@ kinsim <- function(
       sigma_e[2, 4] <- cov_e
       sigma_e[4, 2] <- cov_e
 
-      E_tmp <- rmvn(n_sub, sigma = sigma_e)
+      E_tmp <- .rmvn(n_sub, sigma = sigma_e)
       E.r[idx, 1:2] <- E_tmp[, 1:2] * sE[1]
       E.r[idx, 3:4] <- E_tmp[, 3:4] * sE[2]
     }

diff --git a/R/helpers_simulation.R b/R/helpers_simulation.R
@@ -8,7 +8,7 @@
 #' @return Matrix of dimension \code{n × ncol(sigma)} containing random samples
 #'   from the multivariate normal distribution.
 #' @keywords internal
-rmvn <- function(n, sigma) {
+.rmvn <- function(n, sigma) {
   Sh <- with(
     svd(sigma),
     v %*% diag(sqrt(d)) %*% t(u)
@@ -89,16 +89,17 @@ kinsim_internal <- function(
 
 
     # Generate data for each relatedness group
-    for (i in 1:length(r)) {
+#    for (i in 1:length(r)) {
+    for (i in seq_along(r)) {
       n <- npergroup[i]
 
       # Generate correlated genetic components based on relatedness
-      A.r <- sA * rmvn(n, sigma = diag(2) + S2 * r[i])
+      A.r <- sA * .rmvn(n, sigma = diag(2) + S2 * r[i])
 
       # Generate shared environmental components (same for both members)
       #     C.r <- stats::rnorm(n,sd = sC)
       #   C.r <- cbind(C.r,C.r )
-      C.r <- sC * rmvn(n, sigma = diag(2) + S2 * c_rel)
+      C.r <- sC * .rmvn(n, sigma = diag(2) + S2 * c_rel)
 
       # Generate non-shared environmental components (different for each member)
       E.r <- cbind(
@@ -140,7 +141,7 @@ kinsim_internal <- function(
     # Generate genetic components for each unique relatedness value
     for (i in 1:length(unique_r)) {
       n <- length(r_vector[r_vector == unique_r[i]])
-      A.rz <- sA * rmvn(n, sigma = diag(2) + S2 * unique_r[i])
+      A.rz <- sA * .rmvn(n, sigma = diag(2) + S2 * unique_r[i])
       data_vector$A.r1[data_vector$r_vector == unique_r[i]] <- A.rz[, 1]
       data_vector$A.r2[data_vector$r_vector == unique_r[i]] <- A.rz[, 2]
     }
@@ -149,7 +150,7 @@ kinsim_internal <- function(
       data_vector$A.r1,
       data_vector$A.r2
     ), ncol = 2)
-    C.r <- sC * rmvn(n, sigma = diag(2) + S2 * c_rel)
+    C.r <- sC * .rmvn(n, sigma = diag(2) + S2 * c_rel)
 
     E.r <- cbind(
       stats::rnorm(n, sd = sE),

diff --git a/README.Rmd b/README.Rmd
@@ -21,7 +21,10 @@ knitr::opts_chunk$set(
 [![R package version](https://www.r-pkg.org/badges/version/discord)](https://cran.r-project.org/package=discord)
 [![Package downloads](https://cranlogs.r-pkg.org/badges/grand-total/discord)](https://cran.r-project.org/package=discord)</br>
 [![R-CMD-check](https://github.com/R-Computing-Lab/discord/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/R-Computing-Lab/discord/actions/workflows/R-CMD-check.yaml)
+[![Dev Main branch](https://github.com/R-Computing-Lab/discord/actions/workflows/R-CMD-dev_check.yaml/badge.svg)](https://github.com/R-Computing-Lab/discord/actions/workflows/R-CMD-dev_check.yaml)
+[![Codecov test coverage](https://codecov.io/gh/R-Computing-Lab/discord/graph/badge.svg)](https://app.codecov.io/gh/R-Computing-Lab/discord)
 ![License](https://img.shields.io/badge/License-GPL_v3-blue.svg)
+
 <!-- badges: end -->
 
 The goal of discord is to provide functions for discordant kinship

diff --git a/README.md b/README.md
@@ -14,7 +14,12 @@ version](https://www.r-pkg.org/badges/version/discord)](https://cran.r-project.o
 [![Package
 downloads](https://cranlogs.r-pkg.org/badges/grand-total/discord)](https://cran.r-project.org/package=discord)</br>
 [![R-CMD-check](https://github.com/R-Computing-Lab/discord/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/R-Computing-Lab/discord/actions/workflows/R-CMD-check.yaml)
+[![Dev Main
+branch](https://github.com/R-Computing-Lab/discord/actions/workflows/R-CMD-dev_check.yaml/badge.svg)](https://github.com/R-Computing-Lab/discord/actions/workflows/R-CMD-dev_check.yaml)
+[![Codecov test
+coverage](https://codecov.io/gh/R-Computing-Lab/discord/graph/badge.svg)](https://app.codecov.io/gh/R-Computing-Lab/discord)
 ![License](https://img.shields.io/badge/License-GPL_v3-blue.svg)
+
 <!-- badges: end -->
 
 The goal of discord is to provide functions for discordant kinship

diff --git a/man/rmvn.Rd → man/dot-rmvn.Rd b/man/rmvn.Rd → man/dot-rmvn.Rd