Merge pull request #10 from kbroman/main

Get run_rqtl and run_gemma running

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: GNapi
-Version: 0.3-6
-Date: 2022-09-26
+Version: 0.3-7
+Date: 2022-10-25
 Title: Connection to the GeneNetwork API
 Description: Tools for connecting to the GeneNetwork API.
 Author: Karl W Broman [aut, cre] (<https://orcid.org/0000-0002-4914-6671>)

NEWS.md

@@ -1,3 +1,24 @@
+## GNapi 0.3-7 (2022-10-25)
+
+### Bug fixes
+
+- `run_gemma()` and `run_rqtl()` are working again.
+
+- Trapped additional errors by looking for `Error:` in title of
+  output. (in new internal function `error_in_title()`)
+
+
+## GNapi 0.3-6 (2022-09-26)
+
+### Bug fixes
+
+- `get_geno()` is working again
+
+- `info_pheno()` can no longer get a list of traits within a group
+
+- `list_groups()` no longer takes an individual group name
+
+
 ## GNapi 0.3-4 (2021-11-17)
 
 ### Bug fixes

R/query_gn.R

@@ -11,13 +11,36 @@ query_gn <-
 
     result <- httr::GET(url)
     httr::stop_for_status(result)
+
+    if(error_in_title(result, encoding)) {
+        stop(attr(error_in_title(result, encoding), "error_text"))
+    }
+
     result <- httr::content(result, encoding=encoding, as=output)
 
     result[vapply(result, is.null, TRUE)] <- NA  # added to avoid having as.data.frame(result) crash
 
     check_gn_error(result)
 }
 
+# if the result is a web page with Error: in the title
+error_in_title <-
+    function(result, encoding="UTF-8")
+{
+    result_text <- httr::content(result, encoding=encoding, as="text")
+    error <- regexpr("<title>Error:.*</title>", result_text)
+    if(error < 0) return(FALSE)
+    else {
+        error_text <- substr(result_text, error+13, error+attr(error, "match.length")-23)
+        error_text <- gsub("&#34;", '"', error_text)
+        error_text <- gsub("&#39;", "'", error_text)
+        result <- TRUE
+        attr(result, "error_text") <- error_text
+        return(result)
+    }
+}
+
+
 # check whether the result is an error
 check_gn_error <-
     function(result)

R/run_stuff.R

@@ -14,7 +14,7 @@
 #' @export
 #'
 #' @examples
-#' \dontrun{out <- run_gemma("BXDPublish", "10015")}
+#' out <- run_gemma("HC_M2_0606_P", "1418701_at")
 run_gemma <-
     function(dataset, trait, use_loco=FALSE, maf=0.01, url=gnapi_url())
 {
@@ -30,7 +30,7 @@ run_gemma <-
                               "&maf=", maf),
                        url=url, output="parsed")
 
-    list2df(result)
+    list2df(result[[1]])  # not sure why we need the [[1]]
 }
 
 
@@ -43,7 +43,7 @@ run_gemma <-
 #' @param method Indicates whether to use the EM algorithm, imputation, Haley-Knott regression, the extended Haley-Knott method, or marker regression.
 #' @param model The phenotype model: the usual normal model, a model for binary traits, a two-part model, or non-parametric analysis
 #' @param n_perm Number of permutations
-#' @param control_marker Name of marker to use as control
+#' @param control_marker Name of marker to use as a covariate
 #' @param interval_mapping Whether to use interval mapping
 #' @param url The URL for the GeneNetwork API
 #'
@@ -53,7 +53,7 @@ run_gemma <-
 #' @export
 #'
 #' @examples
-#' \dontrun{out <- run_rqtl("BXDPublish", "10015")}
+#' out <- run_rqtl("HC_M2_0606_P", "1418701_at")
 run_rqtl <-
     function(dataset, trait, method=c("hk", "ehk", "em", "imp", "mr", "mr-imp", "mr-argmax"),
              model=c("normal", "binary", "2part", "np"),