R CMD CHECK passing

.Rbuildignore

@@ -0,0 +1,7 @@
+^renv$
+^renv\.lock$
+^_pkgdown\.yml$
+^docs$
+^pkgdown$
+^LICENSE\.md$
+^.Rprofile$

.Rprofile

@@ -0,0 +1 @@
+source("renv/activate.R")

DESCRIPTION

@@ -10,18 +10,27 @@ URL: https://github.com/jean997/simGWAS
 BugReports: https://github.com/jean997/simGWAS/issues
 Encoding: UTF-8
 LazyData: true
+LazyDataCompression: gzip
 RoxygenNote: 7.2.3
 Depends: 
     R (>= 2.10)
-IMPORTS:
-  dplyr
-  purrr
-  tidyr
+Imports:
+    dplyr,
+    purrr,
+    tidyr,
+    MASS,
+    Matrix,
+    reshape2,
+    utils,
+    stats,
+    magrittr
 VignetteBuilder:
   knitr
 Suggests: 
-    knitr,
-    rmarkdown,
-    hapsim,
-    testthat (>= 3.0.0)
+  knitr,
+  rmarkdown,
+  testthat (>= 3.0.0),
+  DiagrammeR,
+  ggplot2,
+  hapsim
 Config/testthat/edition: 3

NAMESPACE

@@ -1,5 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(print,sim_mv)
+export("%>%")
 export(compute_h2)
 export(fast_lm)
 export(fixed_to_scale_fam)
@@ -22,3 +24,11 @@ export(xyz_to_G)
 import(dplyr)
 import(purrr)
 import(tidyr)
+importFrom(magrittr,"%>%")
+importFrom(stats,cov2cor)
+importFrom(stats,pnorm)
+importFrom(stats,qnorm)
+importFrom(stats,rbinom)
+importFrom(stats,rnorm)
+importFrom(stats,runif)
+importFrom(utils,str)

R/checks.R

@@ -1,11 +1,11 @@
 check_scalar_or_numeric <- function(x, string, n){
   if(is.null(x)) return(x)
-  if("matrix" %in% class(x) | "data.frame" %in% class(x)){
+  if(inherits(x, "matrix") | inherits(x, "data.frame")){
     if(ncol(x) > 1) stop(paste0(string, " must be a numeric vector or one column array."))
     x <- as.numeric(x[,1])
-  }else if(length(x) == 1 & ("numeric" %in% class(x) | all(is.na(x)))){
+  }else if(length(x) == 1 & (inherits(x, "numeric") | all(is.na(x)))){
     x <- rep(x, n)
-  }else if(! "numeric" %in% class(x)){
+  }else if(! inherits(x, "numeric")){
     stop(paste0(string, " must be a numeric vector or one column array."))
   }
   if(length(x) != n) stop(paste0("Expected ", string, " to have length ", n, ", found ", length(x), "\n"))
@@ -15,13 +15,13 @@ check_scalar_or_numeric <- function(x, string, n){
 
 check_matrix <- function(x, string, n, p){
   if(is.null(x)) return(x)
-  if("data.frame" %in% class(x)){
+  if(inherits(x, "data.frame")){
     cat("Coercing ", string, " to matrix.\n")
     x <- as.matrix(x)
     colnames(x) <- NULL
-  }else if("numeric" %in% class(x)){
+  }else if(inherits(x, "numeric")){
     x <- as.matrix(x, ncol = 1)
-  }else if(!"matrix" %in% class(x)){
+  }else if(!inherits(x, "matrix")){
     stop(paste0(string, " must be a numeric vector, matrix, or data.frame."))
   }
   if(!missing(n)){
@@ -35,7 +35,7 @@ check_matrix <- function(x, string, n, p){
 
 
 check_pi <- function(pi, n, p){
-  if("matrix" %in% class(pi)){
+  if(inherits(pi, "matrix")){
     pi <- check_matrix(pi, "pi", n, p)
   }else{
     pi <- check_scalar_or_numeric(pi, "pi", p)
@@ -45,17 +45,17 @@ check_pi <- function(pi, n, p){
 }
 
 check_N <- function(N, n, allow_mat = TRUE){
-  if("sample_size" %in% class(N)){
+  if(inherits(N, "sample_size")){
     if(length(N$N) == n) return(N)
     stop(paste0("Expected information for ", n, " traits but found ", length(N$N), "\n"))
   }
   if(any(is.na(N))){
     stop("N cannot contain missing (NA) values. Use sample size 0 instead.\n")
   }
-  if("matrix" %in% class(N) | "data.frame" %in% class(N)){
+  if(inherits(N, "matrix") | inherits(N, "data.frame")){
     if(ncol(N) == 1){
       type <- "vector"
-    }else if("data.frame" %in% class(N) & "trait_1" %in% names(N)){
+    }else if(inherits(N, "data.frame") & "trait_1" %in% names(N)){
       type <- "df"
     }else{
       if(!allow_mat){
@@ -108,7 +108,7 @@ make_Ndf_indep <- function(N){
 }
 
 check_Ndf <- function(N, M){
-  if(!"data.frame" %in% class(N)){
+  if(!inherits(N, "data.frame")){
     stop("class(N) does not include data.frame\n")
   }
   if(missing(M)){
@@ -163,7 +163,7 @@ check_Ndf <- function(N, M){
 }
 
 subset_N_nonzero <- function(N){
-  stopifnot("sample_size" %in% class(N))
+  stopifnot(inherits(N, "sample_size"))
   i <- which(N$N > 0)
   newN <- N
   newN$N <- N$N[i]
@@ -188,8 +188,8 @@ check_psd <- function(M, string){
 
 
 check_G <- function(G, h2){
-  if(! "matrix" %in% class(G)){
-    if(!(class(G) == "numeric" | class(G) == "integer" )){
+  if(! inherits(G, "matrix")){
+    if(!(inherits(G, "numeric") | inherits(G, "integer") )){
       stop(paste0("G should have class matrix, numeric, or integer, found ", class(G), "\n"))
     }
     if(!(G >= 0 & G == round(G))){
@@ -248,13 +248,13 @@ direct_to_total <- function(G_dir){
 
 check_R_LD <- function(R_LD, return = c("eigen", "matrix", "sqrt", "l")){
   return <- match.arg(return, return)
-  if(class(R_LD) != "list"){
+  if(!inherits(R_LD, "list")){
     stop(paste0("R_LD should be of class list, found ", class(R_LD), "\n"))
   }
   cl <- sapply(R_LD, function(x){
-    case_when("matrix" %in% class(x) ~ "matrix",
-              class(x) == "dsCMatrix" ~ "matrix",
-              class(x) == "eigen" ~ "eigen",
+    dplyr::case_when(inherits(x, "matrix") ~ "matrix",
+              inherits(x, "dsCMatrix") ~ "matrix",
+              inherits(x, "eigen") ~ "eigen",
               TRUE ~ "not_allowed")
   })
   if(any(cl == "not_allowed")){
@@ -321,7 +321,7 @@ check_R_LD <- function(R_LD, return = c("eigen", "matrix", "sqrt", "l")){
 
 
 check_snpinfo <- function(snp_info, J){
-  if(!"data.frame" %in% class(snp_info)){
+  if(!inherits(snp_info, "data.frame")){
     stop("snp_info should have class containing data.frame.\n")
   }
   if(nrow(snp_info) != J){
@@ -336,7 +336,7 @@ check_snpinfo <- function(snp_info, J){
 check_af <- function(af, n, function_ok = TRUE){
   if(is.null(af)){
     return(NULL)
-  }else if(class(af) == "function"){
+  }else if(inherits(af, "function")){
     if(!function_ok) stop("af cannot be a function.\n")
     myaf <- af(n)
     af <- myaf
@@ -347,7 +347,7 @@ check_af <- function(af, n, function_ok = TRUE){
 }
 
 check_effect_function_list <- function(snp_effect_function, M, snp_info = NULL){
-  if(!class(snp_effect_function) == "list"){
+  if(!inherits(snp_effect_function, "list")){
     f <- check_snp_effect_function(snp_effect_function, snp_info)
     fl <- list()
     for(i in 1:M) fl[[i]] <- f
@@ -364,10 +364,10 @@ check_effect_function_list <- function(snp_effect_function, M, snp_info = NULL){
 
 check_snp_effect_function <- function(snp_effect_function, snp_info = NULL){
 
-  if(!(class(snp_effect_function) == "character" | class(snp_effect_function) == "function") ){
+  if(!(inherits(snp_effect_function, "character") | inherits(snp_effect_function, "function")) ){
     stop("snp_effect_function should either be 'normal', a function, or a vector.")
   }
-  if(class(snp_effect_function) == "function"){
+  if(inherits(snp_effect_function, "function")){
     if(!is.null(snp_info)){
       test_snp_info <- snp_info[1:3,]
     }else{

R/compute_h2.R

@@ -1,5 +1,7 @@
 #'@title Compute hertiability from standardized or non-standardized effects
-#'@param b_joint_std,b_joint matrix of standardized or non-standardized effects. Provide only one of these options.
+#'@param b_joint matrix of standardized or non-standardized effects. Provide only one of these options.
+#'@param geno_scale effects should be per allele or sd
+#'@param pheno_sd phenotype standard deviation
 #'@param R_LD LD pattern (optional). See \code{?sim_mv} for more details.
 #'@param af Allele frequencies (optional, allowed only if \code{R_LD} is missing). See \code{?sim_mv} for more details.
 #'@param full_mat If TRUE, return the full genetic variance-covariance matrix

R/gen_bhat_from_b.R

@@ -198,7 +198,7 @@ gen_bhat_from_b <- function(b_joint,
       }
     }
   }
-  ret <- list(beta_hat =beta_hat,
+  ret <- list(beta_hat = beta_hat,
               se_beta_hat = se_beta_hat,
               sx = sx,
               R=R,

R/generate_F.R

@@ -1,3 +1,7 @@
+#' Generate F (simple)
+#' 
+#' @param nblocks nblocks
+#' @param type type
 #'@export
 generate_F_simple <- function(nblocks, type=c("nested", "difference",
                                               "checkers1", "checkers2")){
@@ -21,6 +25,8 @@ generate_F_simple <- function(nblocks, type=c("nested", "difference",
 }
 
 #'@title Generate random F
+#'@param K K
+#'@param M M
 #'@param g_F Function from which non-zero elements of F are generated
 #'@param nz_factor Number of non-zero elements of each factor if F is to be generated.
 #'@param omega Proportion of trait heritability explained by factors
@@ -45,7 +51,7 @@ generate_random_F <- function(K, M, g_F= function(n){runif(n, -1, 1)},
   omega <- check_01(omega, "omega")
   h2_trait <- check_01(h2_trait, "h2_trait")
   srs <- omega*h2_trait
-  F_mat <- sumstatFactors:::generate_F2(non_zero_by_factor = nz_factor,
+  F_mat <- generate_F2(non_zero_by_factor = nz_factor,
                                         square_row_sums = srs,
                                         rfunc = g_F)
   if(any(rowSums(F_mat^2) == 0 & srs != 0) & pad){
@@ -57,6 +63,11 @@ generate_random_F <- function(K, M, g_F= function(n){runif(n, -1, 1)},
   return(F_mat)
 }
 
+#' Generate F (2)
+#' 
+#' @param non_zero_by_factor non_zero_by_factor
+#' @param square_row_sums square_row_sums
+#' @param rfunc rfunc
 #'@export
 generate_F2 <- function(non_zero_by_factor,
                         square_row_sums,

R/hapsim_simple.R

@@ -31,9 +31,9 @@ R_LD_to_haplodat <- function(R_LD, af){
                as.double(P), as.double(Q), rlt = as.double(null.mat),
                PACKAGE = "hapsim")$rlt
     V <- matrix(vmat, nrow = nloci, ncol = nloci)
-    if (!hapsim:::checkpd(V)){
+    if (!hapsim::checkpd(V)){
       warning("Coercing LD matrix to feasible values.\n")
-      V <- hapsim:::makepd(V)
+      V <- hapsim::makepd(V)
     }
     eV <- eigen(V)
     return(list(freqs  = P, cor = C, cov = V, eCov = eV))

R/mixnorm_to_scalefam.R

@@ -1,3 +1,7 @@
+#' mixnorm_to_scale_fam
+#' 
+#' @param sigma sigma
+#' @param pi pi
 #'@export
 mixnorm_to_scale_fam <- function(sigma, pi){
   K <- length(sigma)
@@ -27,9 +31,9 @@ mixnorm_to_scale_fam <- function(sigma, pi){
 
 #'@title Simulate from a normal mixture distribution
 #'@param n Number of points to simulate
-#'@param sigma Standard deviations
-#'@param mu Means
+#'@param sd Standard deviations
 #'@param pi Mixture proportions
+#'@param mu Means
 #'@param return.Z if TRUE, also return a vector of indicators indicating which of the K classes each sample belongs to
 #'@return If return.Z=TRUE, returns a list with elements beta (samples) and Z (indicators). Otherwise returns a length n vector of samples.
 #'@export
@@ -55,8 +59,10 @@ rnormalmix <- function(n, sd, pi, mu =0, return.Z=FALSE){
   return(beta)
 }
 
-
-#'@export
+#' fixed_to_scale_fam
+#' 
+#' @param b vector
+#' @export
 fixed_to_scale_fam <- function(b){
   f <- function(n, sd, ...){
     newb <- b[ ((0:(n-1)) %% length(b)) + 1]