Merge pull request #233 from kbroman/cran

New version on CRAN: 0.36

Author: kbroman

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: qtl2
-Version: 0.35-1
-Date: 2024-03-15
+Version: 0.36
+Date: 2024-05-13
 Title: Quantitative Trait Locus Mapping in Experimental Crosses
 Description: Provides a set of tools to perform quantitative
     trait locus (QTL) analysis in experimental crosses. It is a

NEWS.md

@@ -1,9 +1,17 @@
-## qtl2 0.35-1 (2024-03-15)
+## qtl2 0.36 (2024-05-13)
+
+### Minor changes
+
+- In `scan1snps()`, subset `genoprobs` and `map` to common positions,
+  if they have different markers. (Issue #219)
 
 ### Bug fixes
 
 - Fixed a problem with `sdp_panel=TRUE` in `plot_snpasso()`. (Issue #232)
 
+- Stop `index_snps()` with an error if physical map has missing
+  values. (Issue #218)
+
 
 ## qtl2 0.34 (2023-11-28)
 

R/index_snps.R

@@ -114,6 +114,7 @@ index_snps <-
 
     ### find snps in map
     this_map <- map[[uchr]]
+    if(any(is.na(this_map))) stop("Missing values in map on chr ", uchr)
     snploc <- find_intervals(snpinfo$pos, this_map, tol)
     interval <- snploc[,1]
     on_map <- (snploc[,2]==1)

R/scan1snps.R

@@ -113,21 +113,30 @@ scan1snps <-
     genoprobs <- genoprobs[,cchr]
     map <- map[cchr]
 
-    # check inputs
-    if(length(genoprobs) != length(map)) {
-        stop("length(genoprobs) != length(map)")
-    }
-    if(any(dim(genoprobs)[3,] != vapply(map, length, 1))) {
-        stop("genoprobs and map have different numbers of markers")
-    }
-    dn <- dimnames(genoprobs)[[3]]
-    different_names <- FALSE
-    for(i in seq_along(dn)) {
-        if(any(dn[[i]] != names(map[[i]]))) different_names <- TRUE
-    }
-    if(different_names) { # different marker names...give a warning (maybe should be an error)
-        warning("genoprobs and map have different marker names")
+    # check genoprobs and map have same markers in same order
+    #  - subset to common markers if different
+    #  - stop with error if different order
+    subset_markers <- FALSE
+    for(ichr in names(genoprobs)) {
+        markers_genoprobs <- dimnames(genoprobs[[ichr]])[[3]]
+        markers_map <- names(map[[ichr]])
+
+        if(length(markers_genoprobs) != length(markers_map) ||
+           any(markers_genoprobs != markers_map)) {
+            subset_markers <- TRUE # later give warning
+            markers <- markers_genoprobs[markers_genoprobs %in% markers_map]
+            if(length(markers)==0) stop("No markers in common between genoprobs and map on chr ", ichr)
+            genoprobs[[ichr]] <- genoprobs[[ichr]][,,markers_genoprobs %in% markers,drop=FALSE]
+            map[[ichr]] <- map[[ichr]][markers_map %in% markers]
+
+            markers_genoprobs <- dimnames(genoprobs[[ichr]])[[3]]
+            markers_map <- names(map[[ichr]])
+            if(any(markers_genoprobs != markers_map))
+                stop("Markers in different order between genoprobs and map on chr ", ichr)
+        }
     }
+    if(subset_markers) warning("Subset to common markers between genoprobs and map")
+
     if(!is.null(snpinfo) && !is.null(query_func)) {
         warning("If snpinfo is provided, chr, start, end, and query_func are all ignored")
     }

tests/testthat/test-scan1snps.R

@@ -75,12 +75,24 @@ test_that("scan1snps works", {
     out <- scan1snps(probs, DOex$pmap, DOex$pheno, query_func=queryf, chr=2, start=97.2, end=97.3)
     expect_equal(out, expected)
 
-    # if probs and map don't conform, should get an error
+    # if probs and map don't conform, should get a warning
+    ## (one fewer marker in map)
     junk_map <- DOex$pmap
     junk_map[[1]] <- junk_map[[1]][-1]
+    expect_warning( scan1snps(probs, junk_map, DOex$pheno, query_func=queryf, chr=2,
+                              start=97.2, end=97.3) )
+    ## (one fewere marker in probs)
+    junk_probs <- probs
+    junk_probs[["2"]] <- junk_probs[["2"]][,,-1]
+    expect_warning( scan1snps(junk_probs, DOex$pmap, DOex$pheno, query_func=queryf, chr=2,
+                              start=97.2, end=97.3) )
+    ## markers out of order gives an error though
+    junk_map <- DOex$pmap
+    names(junk_map[["2"]])[1:5] <- names(junk_map[["2"]])[5:1]
     expect_error( scan1snps(probs, junk_map, DOex$pheno, query_func=queryf, chr=2,
                             start=97.2, end=97.3) )
 
+
     # using a pre-defined table of snps
     snpinfo <- queryf(2, 97.2, 97.3)
     out2 <- scan1snps(probs, DOex$pmap, DOex$pheno, snpinfo=snpinfo)