Merge daphne-dev

.Renviron

@@ -0,0 +1,2 @@
+RENV_CONFIG_WATCHDOG_ENABLED = FALSE
+R_BUILD_TAR=tar

.github/workflows/r.yml

@@ -0,0 +1,40 @@
+# This workflow uses actions that are not certified by GitHub.
+# They are provided by a third-party and are governed by
+# separate terms of service, privacy policy, and support
+# documentation.
+#
+# See https://github.com/r-lib/actions/tree/master/examples#readme for
+# additional example workflows available for the R community.
+
+name: R
+
+on:
+ push:
+ branches: [ "master" ]
+ pull_request:
+ branches: [ "master" ]
+
+permissions:
+ contents: read
+
+jobs:
+ build:
+ runs-on: macos-latest
+ strategy:
+ matrix:
+ r-version: ['3.6.3', '4.1.1']
+
+ steps:
+ - uses: actions/checkout@v3
+ - name: Set up R ${{ matrix.r-version }}
+ uses: r-lib/actions/setup-r@f57f1301a053485946083d7a45022b278929a78a
+ with:
+ r-version: ${{ matrix.r-version }}
+ - name: Install dependencies
+ run: |
+ install.packages(c("remotes", "rcmdcheck"))
+ remotes::install_deps(dependencies = TRUE)
+ shell: Rscript {0}
+ - name: Check
+ run: rcmdcheck::rcmdcheck(args = "--no-manual", error_on = "error")
+ shell: Rscript {0}

.gitignore

@@ -5,3 +5,5 @@
 .Rdata
 .httr-oauth
 .DS_Store
+local_only/
+inst/doc

DESCRIPTION

@@ -8,18 +8,21 @@ Description: Produce input files for different balancing selection programs/test
 License: MIT + file LICENSE
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1
 LazyData: true
 Imports: 
  assertthat,
  data.table,
  dplyr,
  glue,
  magrittr,
- reticulate,
- slendr,
- stringr,
- testthat,
- tictoc
+ stringr
 Depends: 
  R (>= 2.10)
+Suggests: 
+ knitr,
+ rmarkdown,
+ testthat (>= 3.1.9),
+ withr
+Config/testthat/edition: 3
+VignetteBuilder: knitr

NAMESPACE

@@ -1,7 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
 export("%>%")
-export(hello)
+export(modmod_read_vcf)
 export(ncd1)
 export(ncd2)
 export(outfile_path)

R/count_alleles.R

@@ -1,17 +1,18 @@
 #' Count derived or ancestral alleles for a given vcf position
-#' @param x A vector containing 0s and 1s corresponding to allele states
-#' @param der Return derived. Logical. If TRUE, returns the counts of
-#' derived (alternate)
-#' alleles. If FALSE, returns ancestral (ref) counts
+#' @param x A vector containing 0s and 1s corresponding to allele states. 0/0: homozygous reference; 0/1: heterozygous; 1/1: homozygous alternate
+
 #' @param split Pattern to look for. Inherited from stringr::str_split
-#' @param index 1 or 2 or c(1,2). Which alleles to consider.
-#' @examples data.table::data.table(col1="1|1", col2="1|0", col3="0|0") %>%
-#' dplyr::summarise(across(col1:col3, .count_alleles))
-.count_alleles<-function(x, split="|",index=c(1,2), der = F){
- x<-.split_geno(x = x, split = split, index = index)
- if(der == T){sum(x, na.rm=T)}else if (der == F){sum(!is.na(x))-sum(x, na.rm=T)}
+
+
+.count_alleles<-function(x, split="|"){
+ x<-.split_geno(x = x, split = split)
+ #if(der == T){sum(x, na.rm=T)}else if (der == F){sum(!is.na(x))-sum(x, na.rm=T)}
+ #sum(!is.na(x))-sum(x, na.rm=T)
+ #ref<-sum(x==0, na.rm=T) #number of ref alleles
+ sum(x==1, na.rm=T) #number of alt alleles
+
 }
-.count_nonmissing<-function(x, split="|",index=c(1,2)){
- x<-.split_geno(x = x, split = split, index = index)
+.count_nonmissing<-function(x, split="|"){
+ x<-.split_geno(x = x, split = split)
  sum(!is.na(x))
 }

R/modified_read_vcf.R

@@ -0,0 +1,39 @@
+#' Read vcf
+#'
+#' @param x The path and name of a vcf file
+#' @return Returns a data.table object containing only SNPs
+#' @export
+#'
+#' @examples read_vcf(x=system.file(package="balselr", "example.vcf"))
+#' @import data.table
+#' @importFrom data.table ":="
+#'
+modmod_read_vcf <- function(x = "inst/example.vcf", pos.range = NULL, id.range = NULL) {
+ inp <- data.table::fread(x, skip = "##", header = TRUE)
+ data.table::setnames(inp, "#CHROM", "CHR")
+
+ inp <- inp[REF %in% c("A", "C", "T", "G") & ALT %in% c("A", "C", "T", "G")]
+
+ if (!is.null(pos.range)) {
+ if (length(pos.range) == 2) {
+ inp <- inp[POS >= pos.range[1] & POS <= pos.range[2]]
+ } else {
+ inp <- inp[POS %in% pos.range]
+ }
+ }
+
+ col.range <- 1:9
+
+ if (!is.null(id.range)) {
+ if (length(id.range) == 2) {
+ col.range <- c(col.range, (10 + id.range[1] - 1):(10 + id.range[2] - 1))
+ } else {
+ col.range <- c(col.range, 9 + id.range)
+ }
+ col.range <- col.range[col.range <= ncol(inp)]
+ }
+
+ inp <- inp[, .SD, .SDcols = col.range]
+
+ return(inp)
+}