Merge branch 'feature/senegal'

.github/workflows/R-CMD-check.yaml

@@ -0,0 +1,29 @@
+# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples
+# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
+on:
+  push:
+    branches: [main, master]
+  pull_request:
+    branches: [main, master]
+
+name: R-CMD-check
+
+jobs:
+  R-CMD-check:
+    runs-on: ubuntu-latest
+    env:
+      GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+      R_KEEP_PKG_SOURCE: yes
+    steps:
+      - uses: actions/checkout@v2
+
+      - uses: r-lib/actions/setup-r@v2
+        with:
+          use-public-rspm: true
+
+      - uses: r-lib/actions/setup-r-dependencies@v2
+        with:
+          extra-packages: any::rcmdcheck
+          needs: check
+
+      - uses: r-lib/actions/check-r-package@v2

.github/workflows/pkgdown.yaml

@@ -0,0 +1,35 @@
+# Workflow derived from https://github.com/r-lib/actions/tree/master/examples
+# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
+on:
+  push:
+    branches: [main, master]
+  release:
+    types: [published]
+  workflow_dispatch:
+
+name: pkgdown
+
+jobs:
+  pkgdown:
+    runs-on: ubuntu-latest
+    env:
+      GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+    steps:
+      - uses: actions/checkout@v2
+
+      - uses: r-lib/actions/setup-pandoc@v1
+
+      - uses: r-lib/actions/setup-r@v1
+        with:
+          use-public-rspm: true
+
+      - uses: r-lib/actions/setup-r-dependencies@v1
+        with:
+          extra-packages: pkgdown
+          needs: website
+
+      - name: Deploy to GitHub pages 🚀
+        run: |
+          git config --local user.name "$GITHUB_ACTOR"
+          git config --local user.email "$GITHUB_ACTOR@users.noreply.github.com"
+          Rscript -e 'pkgdown::deploy_to_branch(new_process = FALSE)'

DESCRIPTION

@@ -1,5 +1,5 @@
 Package: rTASSEL
-Version: 0.9.28
+Version: 0.9.29
 Date: 2018-12-21
 Title: R Front-End for TASSEL
 Authors@R: c(

NAMESPACE

@@ -1,8 +1,10 @@
 # Generated by roxygen2: do not edit by hand
 
 S3method(as.matrix,TasselDistanceMatrix)
+S3method(as.matrix,TasselGenotypePhenotype)
 export(asTasselDistanceMatrix)
 export(assocModelFitter)
+export(concatenate)
 export(createTree)
 export(distanceMatrix)
 export(exportGenotypeTable)
@@ -13,21 +15,28 @@ export(getPhenotypeDF)
 export(getSumExpFromGenotypeTable)
 export(imputeLDKNNi)
 export(imputeNumeric)
+export(intersectJoin)
 export(kinshipMatrix)
 export(ldJavaApp)
 export(ldPlot)
 export(linkageDiseq)
 export(manhattanPlot)
 export(mds)
 export(pca)
+export(positionList)
 export(readGenotypePhenotype)
+export(readGenotypeTableFromGigwa)
 export(readGenotypeTableFromPath)
 export(readPhenotypeFromDataFrame)
 export(readPhenotypeFromPath)
 export(readTasselDistanceMatrix)
 export(seqDiversity)
+export(siteSummary)
 export(startLogger)
+export(taxaList)
+export(taxaSummary)
 export(treeJavaApp)
+export(unionJoin)
 exportClasses(TasselDistanceMatrix)
 exportClasses(TasselGenotypePhenotype)
 exportMethods(colnames)

NEWS

@@ -1,3 +1,20 @@
+# CHANGES IN VERSION 0.9.29
+* Added genotype table summary methods:
+  + `positionList()`
+  + `taxaSummary()`
+  + `siteSummary()`
+* `TasselGenotypePhenotype` objects containing genotype table data can now
+  be coerced into R `matrix` objects using the function `as.matrix()`
+  + This will return a taxa x site matrix where taxa is the number of rows and
+    sites is the number of columns.
+* Added generalized join methods:
+  + `intersectJoin()`
+  + `unionJoin()`
+  + Joins phenotype data data based on taxa ID - similar to the TASSEL API
+* Added read method for importing GIGWA data through `QBMS`:
+  + `readGenotypeTableFromGigwa()`
+
+
 # CHANGES IN VERSION 0.9.28
 * Fixed `log4j` warning issue
   + This removes `log4j` warning messages when the `startLogger()` function

NEWS.md

@@ -1,3 +1,20 @@
+# rTASSEL 0.9.29
+* Added genotype table summary methods:
+  + `positionList()`
+  + `taxaSummary()`
+  + `siteSummary()`
+* `TasselGenotypePhenotype` objects containing genotype table data can now
+  be coerced into R `matrix` objects using the function `as.matrix()`
+  + This will return a taxa x site matrix where taxa is the number of rows and
+    sites is the number of columns.
+* Added generalized join methods:
+  + `intersectJoin()`
+  + `unionJoin()`
+  + Joins phenotype data data based on taxa ID - similar to the TASSEL API
+* Added read method for importing GIGWA data through `QBMS`:
+  + `readGenotypeTableFromGigwa()`
+
+
 # rTASSEL 0.9.28
 * Fixed `log4j` warning issue
   + This removes `log4j` warning messages when the `startLogger()` function

R/AnalysisRelatednessFunctions.R

@@ -304,8 +304,11 @@ pca <- function(
     names(reportBody) <- unlist(reportNames)
     colnames(reportBody$Eigenvalues_Datum) <- gsub(" ", "_", colnames(reportBody$Eigenvalues_Datum))
 
+    # Add `CorePhenotype` object to return
+    reportBody$jPcaObj <- pcaRes$getDataWithName("PC_Datum")$get(0L)$getData()
+
     if (!reportEigenvalues && !reportEigenvectors) {
-        return(reportBody[[1]])
+        return(reportBody[c("PC_Datum", "jPcaObj")])
     } else {
         return(reportBody)
     }

R/GenomicPrediction.R

@@ -68,7 +68,7 @@
 #' @export
 genomicPrediction <- function(tasPhenoObj, kinship, doCV = FALSE, kFolds, nIter) {
     ## Check for correct rTASSEL class
-    if (class(tasPhenoObj) != "TasselGenotypePhenotype") {
+    if (!inherits(tasPhenoObj, "TasselGenotypePhenotype")) {
         stop("`tasObj` must be of class `TasselGenotypePhenotype`", call. = FALSE)
     }
 
@@ -82,7 +82,8 @@ genomicPrediction <- function(tasPhenoObj, kinship, doCV = FALSE, kFolds, nIter)
     tasPhenoObj <- tasPhenoObj@jPhenotypeTable
 
     ## Check to see if kinship parameter is of rJava and DistanceMatrix class
-    if (class(kinship) != "TasselDistanceMatrix") {
+    ## class(kinship) != "TasselDistanceMatrix"
+    if (!inherits(kinship, "TasselDistanceMatrix")) {
         stop("TASSEL kinship object is not of TasselDistanceMatrix class", call. = FALSE)
     }
     kinship <- kinship@jDistMatrix

R/GenotypeTableFunctions.R

@@ -46,6 +46,7 @@ readGenotypeTableFromPath <- function(path, keepDepth = FALSE, sortPositions = F
 }
 
 
+## ----
 #' @title Create Summarized Experiment from a TASSEL Genotype Table
 #'
 #' @description This function will generate an object of
@@ -114,6 +115,7 @@ getSumExpFromGenotypeTable <- function(tasObj,
 }
 
 
+## ----
 ## Get a GenotypeTable - not exported (house keeping)
 getGenotypeTable <- function(jtsObject) {
     if(is(jtsObject, "TasselGenotypePhenotype")) {
@@ -130,6 +132,7 @@ getGenotypeTable <- function(jtsObject) {
 }
 
 
+## ----
 ## Return min/max physical positions from genotype tables (house keeping)
 #' @importFrom rJava .jevalArray
 #' @importFrom rJava is.jnull
@@ -159,6 +162,7 @@ getMinMaxPhysPositions <- function(tasObj) {
 }
 
 
+## ----
 ## Return min/max physical positions from genotype tables (house keeping)
 #' @importFrom rJava .jevalArray
 #' @importFrom rJava is.jnull
@@ -183,3 +187,149 @@ getMinMaxVarSites <- function(tasObj) {
 }
 
 
+##----
+#' @title Read genotype data from GIGWA using QBMS
+#'
+#' @description Reads and stores genotype information from a
+#'    \code{QBMS}-formatted data frame from a GIGWA server
+#'
+#' @param gigwa A \code{QBMS}-formatted GIGWA data frame object
+#'
+#' @importFrom rJava .jarray
+#' @importFrom rJava J
+#'
+#' @export
+readGenotypeTableFromGigwa <- function(gigwa) {
+    plugin <- rJava::J("net/maizegenetics/plugindef/GenerateRCode")
+
+    matrixSub <- as.matrix(gigwa[, 5:ncol(gigwa)])
+    mode(matrixSub) <- "integer"
+
+    myGt <- plugin$createGenotypeFromRDataFrameElements(
+        rJava::.jarray(colnames(gigwa[, 5:ncol(gigwa)])),
+        rJava::.jarray(gigwa$chrom),
+        rJava::.jarray(as.integer(gigwa$pos)),
+        rJava::.jarray(gigwa$`rs#`),
+        rJava::.jarray(gigwa$alleles),
+        rJava::.jarray(matrixSub, dispatch = TRUE)
+    )
+
+    return(.tasselObjectConstructor(myGt))
+}
+
+
+## ----
+#' @title Coerce genotype table to R matrix
+#'
+#' @description Converts a \code{TasselGenotypePhenotype} class into an R
+#'    matrix if it contains genotype data.
+#'
+#' @param x A \code{TasselGenotypePhenotype} object
+#' @param ... Additional arguments to be passed to or from methods.
+#'
+#' @importFrom rJava .jevalArray
+#'
+#' @export
+as.matrix.TasselGenotypePhenotype <- function(x, ...) {
+    plugin <- rJava::J("net/maizegenetics/plugindef/GenerateRCode")
+
+    if (class(x) != "TasselGenotypePhenotype") {
+        stop("`x` must be of class `TasselGenotypePhenotype`")
+    }
+
+    if (rJava::is.jnull(x@jGenotypeTable)) {
+        stop("`x` must contain genotype data")
+    }
+
+    jg <- x@jGenotypeTable
+    m <- rJava::.jevalArray(plugin$genotypeTableToDosageByteArray(jg), simplify = TRUE)
+    mode(m) <- "integer"
+
+    siteNames <- positionList(x)
+
+    m[m == 128] <- NA
+    colnames(m) <- siteNames$Name
+    rownames(m) <- getTaxaIDs(x)
+
+    return(m)
+}
+
+
+## ----
+#' @title Get site summary of genotype table
+#'
+#' @description Returns positional data from a \code{TasselGenotypePhenotype}
+#'    object
+#'
+#' @param tasObj A \code{TasselGenotypePhenotype} object
+#'
+#' @export
+siteSummary <- function(tasObj) {
+    if (class(tasObj) != "TasselGenotypePhenotype") {
+        stop("`tasObj` must be of class `TasselGenotypePhenotype`")
+    }
+
+    if (rJava::is.jnull(tasObj@jGenotypeTable)) {
+        stop("`tasObj` must contain genotype data")
+    }
+
+    plugin <- rJava::new(
+        rJava::J("net.maizegenetics.analysis.data.GenotypeSummaryPlugin"),
+        rJava::.jnull(),
+        FALSE
+    )
+
+    plugin$setParameter("overview", tolower(as.character(FALSE)))
+    plugin$setParameter("siteSummary", tolower(as.character(TRUE)))
+    plugin$setParameter("taxaSummary", tolower(as.character(FALSE)))
+
+    dataSet <- rJava::J("net.maizegenetics.plugindef.DataSet")
+    summaryResults <- plugin$processData(dataSet$getDataSet(tasObj@jGenotypeTable))
+
+    return(
+        tableReportToDF(
+            summaryResults$getData(0L)$getData()
+        )
+    )
+}
+
+
+## ----
+#' @title Get taxa summary of genotype table
+#'
+#' @description Returns taxa data from a \code{TasselGenotypePhenotype}
+#'    object
+#'
+#' @param tasObj A \code{TasselGenotypePhenotype} object
+#'
+#' @export
+taxaSummary <- function(tasObj) {
+    if (class(tasObj) != "TasselGenotypePhenotype") {
+        stop("`tasObj` must be of class `TasselGenotypePhenotype`")
+    }
+
+    if (rJava::is.jnull(tasObj@jGenotypeTable)) {
+        stop("`tasObj` must contain genotype data")
+    }
+
+    plugin <- rJava::new(
+        rJava::J("net.maizegenetics.analysis.data.GenotypeSummaryPlugin"),
+        rJava::.jnull(),
+        FALSE
+    )
+
+    plugin$setParameter("overview", tolower(as.character(FALSE)))
+    plugin$setParameter("siteSummary", tolower(as.character(FALSE)))
+    plugin$setParameter("taxaSummary", tolower(as.character(TRUE)))
+
+    dataSet <- rJava::J("net.maizegenetics.plugindef.DataSet")
+    summaryResults <- plugin$processData(dataSet$getDataSet(tasObj@jGenotypeTable))
+
+    return(
+        tableReportToDF(
+            summaryResults$getData(0L)$getData()
+        )
+    )
+}
+
+