Merge pull request #188 from kbroman/master

Several small changes

Author: kbroman

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: qtl2
-Version: 0.23-13
-Date: 2020-12-10
+Version: 0.23-14
+Date: 2020-12-15
 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

@@ -13,6 +13,9 @@
 
 - `fit1()` now returns both fitted values and residuals.
 
+- `fit1()` can be run with genotype probabilities omitted, in which
+  case an intercept column of 1's is used (Issue #151).
+
 - Updated mouse gene database with 2020-09-07 data from
   [MGI](http://www.informatics.jax.org/downloads/mgigff3/archive/monthly/).
 
@@ -21,6 +24,10 @@
 - Make the [vdiffr](https://vdiffr.r-lib.org) package optional: only
   test the plots locally, and only if vdiffr is installed.
 
+- `calc_sdp()` can now take a plain vector (Issue #142).
+
+- Added a `lodcolumn` argument to `maxlod()` (Issue #137).
+
 ### Bug fixes
 
 - Fixed [Issue #181](https://github.com/rqtl/qtl2/issues/181), where

R/calc_sdp.R

@@ -23,9 +23,14 @@ calc_sdp <-
     function(geno)
 {
     # tolerate data frames, but convert to matrix
-    if(!is.matrix(geno) && is.data.frame(geno))
-        geno <- as.matrix(geno)
-    if(!is.matrix(geno)) stop("geno should be a matrix")
+    if(!is.matrix(geno)) {
+        if(is.data.frame(geno)) {
+            geno <- as.matrix(geno)
+        } else {
+            geno <- rbind(geno)
+            dimnames(geno) <- NULL
+        }
+    }
 
     n_str <- ncol(geno)
 

R/fit1.R

@@ -3,7 +3,8 @@
 #' Fit a single-QTL model at a single putative QTL position and get detailed results
 #' about estimated coefficients and individuals contributions to the LOD score.
 #'
-#' @param genoprobs A matrix of genotype probabilities, individuals x genotypes
+#' @param genoprobs A matrix of genotype probabilities, individuals x genotypes.
+#'     If NULL, we create a single intercept column, matching the individual IDs in `pheno`.
 #' @param pheno A numeric vector of phenotype values (just one phenotype, not a matrix of them)
 #' @param kinship Optional kinship matrix.
 #' @param addcovar An optional numeric matrix of additive covariates.
@@ -122,9 +123,14 @@ fit1 <-
              contrasts=NULL, model=c("normal", "binary"),
              zerosum=TRUE, se=TRUE, hsq=NULL, reml=TRUE, blup=FALSE, ...)
 {
-    if(is.null(genoprobs)) stop("genoprobs is NULL")
     if(is.null(pheno)) stop("pheno is NULL")
 
+    if(missing(genoprobs) || is.null(genoprobs)) { # create matrix of 1's
+        if(!is.matrix(pheno)) pheno <- cbind(pheno)
+        genoprobs <- matrix(1, ncol=1, nrow=nrow(pheno))
+        dimnames(genoprobs) <- list(rownames(pheno), "intercept")
+    }
+
     model <- match.arg(model)
 
     if(blup) {

R/max_scan1.R

@@ -163,6 +163,9 @@ max.scan1 <-
 #' @param map A list of vectors of marker positions, as produced by
 #' [insert_pseudomarkers()].
 #' @param chr Optional vector of chromosomes to consider.
+#' @param lodcolumn An integer or character string indicating the LOD
+#' score column, either as a numeric index or column name.
+#' If `NULL`, return maximum for all columns.
 #'
 #' @export
 #' @return A single number: the maximum LOD score across all columns and positions for
@@ -193,7 +196,7 @@ max.scan1 <-
 #' # maximum on chromosome 2
 #' maxlod(out, map, "2")
 maxlod <-
-    function(scan1_output, map=NULL, chr=NULL)
+    function(scan1_output, map=NULL, chr=NULL, lodcolumn=NULL)
 {
     if(is.null(scan1_output)) stop("scan1_output is NULL")
 
@@ -206,6 +209,10 @@ maxlod <-
         scan1_output <- subset(scan1_output, map=map, chr=chr)
     }
 
+    if(!is.null(lodcolumn)) {
+        scan1_output <- subset(scan1_output, lodcolumn=lodcolumn)
+    }
+
     # to handle output of either scan1() or scan1coef()
     # for coef(), look at the sign
     if(inherits(scan1_output, "scan1coef")) {

README.md

@@ -1,4 +1,4 @@
-### [R/qtl2](https://kbroman.org/qtl2)
+### [R/qtl2](https://kbroman.org/qtl2/)
 
 [![R build status](https://github.com/rqtl/qtl2/workflows/R-CMD-check/badge.svg)](https://github.com/rqtl/qtl2/actions)
 [![CRAN_Status_Badge](https://www.r-pkg.org/badges/version/qtl2)](https://cran.r-project.org/package=qtl2)

man/fit1.Rd

@@ -126,7 +126,7 @@ test_that("basic summaries give correct numbers for grav2 data", {
 
 test_that("basic summaries give correct numbers for recla data", {
 
-    skip_if(isnt_karl(), "This test only run locally")
+    skip_if(isnt_karl(), "this test only run locally")
 
     file <- paste0("https://raw.githubusercontent.com/rqtl/",
                    "qtl2data/master/DO_Recla/recla.zip")

man/maxlod.Rd

@@ -28,7 +28,7 @@ test_that("calc_het works for an intercross", {
 
 test_that("calc_het works with multi-core", {
 
-    skip_if(isnt_karl(), "This test only run locally")
+    skip_if(isnt_karl(), "this test only run locally")
 
     iron <- read_cross2(system.file("extdata", "iron.zip", package="qtl2"))
     pr <- calc_genoprob(iron, err=0.002)