Error handling (#21)

* catch job submit errors

* na to string

* Update display.R

* error handling and validation

* Update DESCRIPTION

Author: suu-yi

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: CyteTypeR
 Title: CyteType for R
-Version: 0.0.1
+Version: 0.0.2
 Description: CyteTypeR is the R version of CyteType python package.'
 Authors@R: 
     person("Nygen Analytics AB", , ,"contact@nygen.io", role = c("aut", "cre"))

NAMESPACE

@@ -1,8 +1,10 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(print,cytetype_api_error)
 export(CyteTypeR)
 export(GetResults)
 export(PrepareCyteTypeR)
+export(cytetype_api_error)
 importFrom(Matrix,rowSums)
 importFrom(Seurat,AddMetaData)
 importFrom(Seurat,Embeddings)

R/client.R

@@ -2,7 +2,7 @@
 .submit_job <- function(payload, api_url, auth_token = NULL){
 
   submit_url <- file.path(api_url, "annotate")
-  log_info("Submitting job to {submit_url}")
+  log_info("Submitting job to API {api_url}")
 
   tryCatch({
     # Validate inputs
@@ -13,7 +13,7 @@
     # Build request
     req <- request(submit_url) |>
       req_method("POST") |>
-      req_body_json(payload) |>
+      req_body_json(payload, na = "string") |>
       req_headers("Content-Type" = "application/json") |>
       req_timeout(60)
 
@@ -206,7 +206,7 @@
   for (i in seq_len(duration * 2)) {
     Sys.sleep(0.5)
     if (show_progress){
-      .display_cluster_status_cli(cluster_status,is_final=FALSE,i)
+      .display_cluster_status_cli(cluster_status, is_final=FALSE, spinner_frame=i)
     }
 
   }

R/cytetype.R

@@ -81,6 +81,8 @@ PrepareCyteTypeR <- function(obj,
   sorted_clusters <- sort(unique(obj[[group_key, drop = TRUE]]))
   cluster_map <- setNames(as.character(1:length(sorted_clusters)), sorted_clusters)
 
+  .validate_marker_table(marker_table,sorted_clusters)
+
   if (aggregate_metadata){
     print("Aggregating metadata...")
     group_metadata <- .aggregate_metadata(obj,group_key)
@@ -89,6 +91,8 @@ PrepareCyteTypeR <- function(obj,
 
   } else{group_metadata <- list()
   }
+  print(paste("Preparing marker genes with top",n_top_genes,"genes..."))
+
   marker_genes <- marker_table %>%
     group_by(cluster) %>%
     dplyr::filter(avg_log2FC > 1) %>%
@@ -240,9 +244,17 @@ CyteTypeR <- function(obj,
   if (save_query){
     write_json(query_list, path = query_filename, auto_unbox = TRUE, pretty = TRUE)
   }
+  ## NA value check on all data before submitting job
+
 
   # Job submission
-  job_id <- .submit_job(query_list, api_url, auth_token)
+  tryCatch({
+    job_id <- .submit_job(query_list, api_url, auth_token)
+    },
+    error = function(e) {
+      stop("Job submission failed: ", conditionMessage(e))
+    }
+  )
 
   # Save job details
   report_url <- file.path(api_url, 'report',job_id)

R/display.R

@@ -3,7 +3,7 @@
 
 # Visuals for cluster progress status
 
-.display_cluster_status_cli <- function(cluster_status, job_id, is_final = FALSE, spinner_frame = 0) {
+.display_cluster_status_cli <- function(cluster_status, is_final = FALSE, spinner_frame) {
   if (length(cluster_status) == 0) return()
 
   # Status symbols and colors

R/errors.R

@@ -0,0 +1,17 @@
+#' Custom API Error
+#'
+#' @param message Error message
+#' @param call Call that generated the error
+#' @return An error object of class cytetype_api_error
+#' @export
+cytetype_api_error <- function(message, call = NULL) {
+  structure(
+    list(message = message, call = call),
+    class = c("cytetype_api_error", "error", "condition")
+  )
+}
+
+#' @export
+print.cytetype_api_error <- function(x, ...) {
+  cat("CyteType API Error: ", x$message, "\n")
+}

R/seurat_helpers.R

@@ -15,7 +15,7 @@
 ){
   gene_names <- rownames(seurat_obj)
   clusters <- seurat_obj[[group_key]][[group_key]]
-  unique_clusters <- levels(clusters)
+  unique_clusters <- unique(clusters)
 
   pcent <- list()
   n_genes <- dim(seurat_obj)[1]
@@ -165,6 +165,45 @@
   }
 }
 
+
+.validate_marker_table <- function(marker_table, sorted_clusters){
+  log_info("Checking markers table...")
+  df_like_classes <- c("data.frame", "tbl_df", "tbl", "data.table")
+  if (inherits(marker_table, df_like_classes)){
+    log_info(paste("Provided markers data is a dataframe", cli::symbol$tick))
+  }
+
+  if (any(is.na(marker_table))){
+    log_info("NA value(s) found in the table")
+  }
+  else{ log_info(paste("No NA values", cli::symbol$tick))}
+
+  table_cols <- names(marker_table)
+  if ("cluster" %in% table_cols){
+    log_info(paste("'cluster' column found in marker table", cli::symbol$tick))
+  }
+  else{log_info("cluster column not found in marker table, rename your column to 'cluster' if its name is different" )}
+
+  # gene symbol column exist?
+  # has gene symbols?
+  if ("gene" %in% table_cols){
+    gene_sym_pattern <- "^[A-Z]([A-Z0-9-]+|[a-z0-9-]+)$"
+    if (is.null(grepl(gene_sym_pattern,marker_table$gene))){
+      log_warn("Not gene symbols?")
+    }
+    else {log_info(paste("Found gene symbols", cli::symbol$tick))}
+  }
+  # cluster labels == seurat obj labels?
+  if (setequal(sorted_clusters, as.vector(marker_table$cluster))){
+    log_info(paste("Correct cluster labels", cli::symbol$tick))
+  }
+  else{
+    log_error("Please check if cluster labels are consistent between marker table and seurat obj!")
+  }
+
+  log_info(paste("Markers check: done", cli::symbol$tick))
+}
+
 # Transform CyteType Results for Seurat Integration
 
 .transform_results_seurat <- function(raw_results = NULL, job_id = NULL, filename = NULL, cluster_map = NULL){