Improve customized messages

NAMESPACE

@@ -42,8 +42,7 @@ importFrom(Matrix,rowSums)
 importFrom(Matrix,sparseMatrix)
 importFrom(Matrix,t)
 importFrom(Matrix,tcrossprod)
-importFrom(crayon,magenta)
-importFrom(crayon,red)
+importFrom(crayon,combine_styles)
 importFrom(ggplot2,aes)
 importFrom(ggplot2,aes_string)
 importFrom(ggplot2,annotate)

R/set_R_attributes.R

@@ -15,7 +15,7 @@ set_R_attributes = function (R, r_tol) {
   if(any(eigenR$values < 0)) {
     min_lambda = min(eigenR$values)
     eigenR$values[eigenR$values < 0] = 0
-    warning(paste0("The input correlation matrix has negative eigenvalues ",
+    warning_message(paste0("The input correlation matrix has negative eigenvalues ",
                    "(smallest one is ", min_lambda, "). The correlation ",
                    "matrix is adjusted such that these negative eigenvalues ",
                    "are now zeros. You can ignore this message, only if you ",

R/susie.R

@@ -296,7 +296,6 @@
 #'
 #' @importFrom stats var
 #' @importFrom utils modifyList
-#' @importFrom crayon magenta
 #'
 #' @export
 #'
@@ -360,9 +359,9 @@ susie = function (X,y,L = min(10,ncol(X)),
   }
   p = ncol(X)
   if (p > 1000 & !requireNamespace("Rfast",quietly = TRUE))
-    message(magenta("For an X with many columns, please consider installing",
+    warning_message("For an X with many columns, please consider installing",
                     "the Rfast package for more efficient credible set (CS)",
-                    "calculations."))
+                    "calculations.", style='hint')
 
   # Check input y.
   n = nrow(X)

R/susie_rss.R

@@ -194,9 +194,9 @@ susie_rss = function (z, R, n, bhat, shat, var_y,
                       check_prior = TRUE, ...) {
 
   if (!estimate_residual_variance)
-    message("If the in-sample LD matrix is available, we recommend calling ",
+    warning_message("If the in-sample LD matrix is available, we recommend calling ",
             "susie_rss with the in-sample LD matrix, and setting ",
-            "estimate_residual_variance = TRUE")
+            "estimate_residual_variance = TRUE", style="hint")
 
   # Check input R.
   if (missing(z))

R/susie_rss_lambda.R

@@ -85,7 +85,7 @@ susie_rss_lambda = function(z, R, maf = NULL, maf_thresh = 0,
   if (check_z) {
     proj = check_projection(R,z)
     if (!proj$status)
-      warning("Input z does not lie in the space of non-zero eigenvectors ",
+      warning_message("Input z does not lie in the space of non-zero eigenvectors ",
               "of R.")
     else
       message("Input z is in space spanned by the non-zero eigenvectors of ",

R/susie_ss.R

@@ -41,7 +41,6 @@
 #' @param n_purity Passed as argument \code{n_purity} to
 #'   \code{\link{susie_get_cs}}.
 #'
-#' @importFrom crayon red magenta
 #'
 #' @export
 #'
@@ -77,16 +76,16 @@ susie_suff_stat = function (XtX, Xty, yty, n,
     stop("Please provide all of XtX, Xty, yty, n")
 
   if (ncol(XtX) > 1000 & !requireNamespace("Rfast",quietly = TRUE))
-    message(magenta("For large R or large XtX, consider installing the",
-                    "Rfast package for better performance."))
+    warning_message("For large R or large XtX, consider installing the",
+                    "Rfast package for better performance.", style="hint")
 
   # Check input XtX.
   if (ncol(XtX) != length(Xty))
     stop(paste0("The dimension of XtX (",nrow(XtX)," by ",ncol(XtX),
                 ") does not agree with expected (",length(Xty)," by ",
                 length(Xty),")"))
   if (!is_symmetric_matrix(XtX)) {
-    message("XtX is not symmetric; forcing XtX to be symmetric by ",
+    warning_message("XtX is not symmetric; forcing XtX to be symmetric by ",
             "replacing XtX with (XtX + t(XtX))/2")
     XtX = XtX + t(XtX)
     XtX = XtX/2

R/susie_utils.R

@@ -256,7 +256,6 @@ susie_get_posterior_samples = function (susie_fit, num_samples) {
 #'   By default \code{use_rfast = TRUE} if the Rfast package is
 #'   installed.
 #'
-#' @importFrom crayon red
 #'
 #' @export
 #'
@@ -267,8 +266,8 @@ susie_get_cs = function (res, X = NULL, Xcorr = NULL, coverage = 0.95,
     stop("Only one of X or Xcorr should be specified")
   if (check_symmetric) {
     if (!is.null(Xcorr) && !is_symmetric_matrix(Xcorr)) {
-      message(red("Xcorr is not symmetric; forcing Xcorr to be symmetric",
-                  "by replacing Xcorr with (Xcorr + t(Xcorr))/2"))
+      warning_message("Xcorr is not symmetric; forcing Xcorr to be symmetric",
+                  "by replacing Xcorr with (Xcorr + t(Xcorr))/2")
       Xcorr = Xcorr + t(Xcorr)
       Xcorr = Xcorr/2
     }
@@ -369,8 +368,6 @@ susie_get_cs = function (res, X = NULL, Xcorr = NULL, coverage = 0.95,
 #' @return A matrix of correlations between CSs, or the maximum
 #'   absolute correlation when \code{max = TRUE}.
 #'
-#' @importFrom crayon red
-#'
 #' @export
 #'
 get_cs_correlation = function (model, X = NULL, Xcorr = NULL, max = FALSE) {
@@ -380,8 +377,8 @@ get_cs_correlation = function (model, X = NULL, Xcorr = NULL, max = FALSE) {
   if (is.null(Xcorr) && is.null(X))
     stop("One of X or Xcorr must be specified")
   if (!is.null(Xcorr) && !is_symmetric_matrix(Xcorr)) {
-    message(red("Xcorr is not symmetric; forcing Xcorr to be symmetric",
-                "by replacing Xcorr with (Xcorr + t(Xcorr))/2"))
+    warning_message("Xcorr is not symmetric; forcing Xcorr to be symmetric",
+                "by replacing Xcorr with (Xcorr + t(Xcorr))/2")
     Xcorr = Xcorr + t(Xcorr)
     Xcorr = Xcorr/2
   }
@@ -978,3 +975,18 @@ check_projection = function (A, b) {
   else
     return(list(status = FALSE,msg = msg))
 }
+
+# @title Utility function to display warning messages as they occur
+# @param ... warning message
+# @param style either "warning" or "hint"
+#'@importFrom crayon combine_styles
+warning_message = function(..., style=c("warning", "hint")) {
+  style = match.arg(style)
+  if (style=="warning") {
+    alert <- combine_styles("bold", "underline", "red")	
+    message(alert("WARNING:"), " ", ...)
+  } else {
+    alert <- combine_styles("bold", "underline", "magenta")	
+    message(alert("HINT:"), " ", ...)
+  }
+}