item_buffer vectorized; item labels can keep original order.

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: venndir
 Title: Directional Venn diagrams
-Version: 0.0.42.900
+Version: 0.0.43.900
 Authors@R: c(
     person(given="James M.",
        family="Ward",

NEWS.md

@@ -1,3 +1,35 @@
+# venndir 0.0.43.900
+
+## changes to existing functions
+
+* `label_fill_JamPolygon()`
+
+   * Minor adjustment to how the item buffer is determined with decreasing
+   number of items. Slightly more centralized with 3 or fewer items.
+
+* `render_venndir()` (and `venndir()`)
+
+   * Now accepts `item_buffer` as a vector, recycled to all overlap sets.
+   * No longer sorts item labels, instead they are expected to be
+   sorted (or not) by `signed_overlaps()`.
+
+* `signed_overlaps()`
+
+   * New argument `keep_item_order=FALSE` by default sorts all items
+   using `jamba::mixedSort()` (proper alphanumeric sort).
+   When `keep_item_order=TRUE` it will keep items in the same order
+   they originally appeared, which allows a fixed item label order
+   when displaying item labels.
+
+* `venn_meme()`
+
+   * New argument `keep_item_order=TRUE` whose default will keep each
+   overlap label in the order they are provided. Usually there is only
+   one label per overlap, but if it is provided as a `list` with multiple
+   entries, they will be rendered in the order they are provided.
+   Motivated by efforts to "reproduce the Venn diagram from a paper."
+
+
 # venndir 0.0.42.900
 
 ## changes to existing functions

R/venndir-label-fill-jp.R

@@ -163,6 +163,16 @@ label_fill_JamPolygon <- function
    ##
    label_method <- match.arg(label_method);
    plot_style <- match.arg(plot_style);
+
+   if (length(buffer) == 0) {
+      buffer <- -0.15;
+   } else {
+      buffer <- head(buffer, 1)
+   }
+   if (buffer <= -1) {
+      buffer <- -0.99
+   }
+
    if (length(seed) == 1) {
       set.seed(seed);
    }
@@ -208,20 +218,24 @@ label_fill_JamPolygon <- function
    }
 
    # adjust buffer based upon number of labels 
-   if (length(apply_n_scale) > 0 && TRUE %in% apply_n_scale) {
+   if (TRUE %in% apply_n_scale) {
       if (length(ref_jp) > 0) {
          jp_area <- sum(area_JamPolygon(jp));
          ref_jp_area <- sum(area_JamPolygon(union_JamPolygon(ref_jp)));
          jp_pct1 <- jp_area / ref_jp_area;
+         # at least 33% of the total area uses full buffer,
+         # any smaller than 33% gets larger buffer to shrink effective area.
          jp_pct <- jamba::noiseFloor(jp_pct1 * 3, ceiling=1);
       } else {
          jp_pct <- 1;
       }
       # n_scale <- 1 - (1 / (sqrt(n)*2)) * jp_pct;
-      n_scale <- 1 - (1 / (sqrt(n) * 1.5)) * jp_pct;# 0.0.30.900
-      # apply to buffer
       # scale_width <- (scale_width + 1) * (1 - (1 - n_scale) * 1.1) - 1;
-      new_buffer <- (buffer + 1) * (1 - (1 - n_scale) * 1.1) - 1;
+      # 0.0.42.900
+      n_scale <- 1 - (1 / (sqrt(n) * 1.5)) * jp_pct;# 0.0.42.900
+      new_buffer <- (buffer + 1) * (1 - (1 - n_scale) * 1.2) - 1;
+      # print(data.frame(buffer, new_buffer));# debug
+      # apply to buffer
       buffer <- new_buffer;
    }
 

R/venndir-meme.R

@@ -60,6 +60,10 @@
 #'    not helpful for Venn memes. To enable auto-scaling, use
 #'    `item_cex=NULL`. See help text in `venndir()` for more
 #'    details.
+#' @param keep_item_order `logical` default TRUE, to maintain labels
+#'    in the order they are provided for each overlap.
+#'    Use FALSE to have each label sorted using `jamba::mixedSort()`
+#'    for true alphanumeric sort.
 #' @param plot_warning `logical` passed to `render_venndir()` to determine
 #'    whether to plot any warnings caused by proportional Euler diagrams
 #'    which cannot display all overlapping regions. It should not be
@@ -174,6 +178,29 @@
 #' )
 #' venn_meme(mrvenn, proportional=TRUE, item_style="text")
 #' 
+#' # example of ordered item labels
+#' item_list <- list(
+#'    CLE=(c("**CLE**:",
+#'       "IFN&alpha; > IFN&beta;",
+#'       "Anti-malarials effective\ntherapy for\nskin disease")),
+#'    DM=(c("\n\n**DM**:",
+#'       "\n\nIFN&beta; > IFN&alpha;",
+#'       "\nTriggered by\nimmune stimulating\nherbal supplements",
+#'       "\n\n\nAnti-malarials\neffective in 25%,\ncommonly causes\nmorbilliform rash",
+#'       "\n\n\n\n\nCannabinoid receptor\nagonist proising\ntreatment",
+#'       "  ")),
+#'    `CLE&DM`=(c(
+#'       "Photosensitivity",
+#'       "Triggered by viral and\nbacterial infections",
+#'       "Increased\ntype I IFN")))
+#' vo <- venndir::venn_meme(x=item_list,
+#'    item_cex=c(1.3, 1.2, 1.3),
+#'    item_buffer=c(-0.5, -0.2, -0.75),
+#'    set_colors=c("darkorchid3", "gold"),
+#'    poly_alpha=0.3,
+#'    xyratio=5,
+#'    dither_cex=0)
+#' 
 #' @export
 venn_meme <- function
 (x,
@@ -182,6 +209,7 @@ venn_meme <- function
  item_degrees=0,
  item_buffer=-0.85,
  item_style=c("gridtext", "text"),
+ keep_item_order=TRUE,
  plot_warning=FALSE,
  draw_legend=FALSE,
  verbose=FALSE,
@@ -234,6 +262,7 @@ venn_meme <- function
       proportional=proportional,
       show_items="item",
       show_labels="i",
+      keep_item_order=keep_item_order,
       # label_preset="meme",
       item_degrees=item_degrees,
       item_cex=item_cex * 1,

R/venndir-overlap.R

@@ -86,8 +86,40 @@
 #'    present in the overlap. When `include_blanks=TRUE` is useful
 #'    in that it guarantees all possible combinations of overlaps
 #'    are represented consistently in the output.
+#' @param keep_item_order `logical` default FALSE, to determine whether
+#'    items will be stored and displayed in the order they are provided.
+#'    Note: `keep_item_order=TRUE` enables the following behaviors:
+#'    * Any `character` vector input will retain the order they appear.
+#'    * Any `factor` vector input will sort items using factor `levels`,
+#'    which maintains the factor level order.
+#'    * Any named vector will use the `character` vector of names, keeping
+#'    the order they appear in the vector.
+#' @param verbose `logical` indicating whether to print verbose output.
 #' @param ... additional arguments are passed to `list2imsigned()`.
 #' 
+#' @returns `data.frame` with columns intended to support `venndir()`,
+#' but which may be more widely useful:
+#' * `"sets"` - character vector with sets and overlap names.
+#' * one column indicating the `overlap_type` and corresponding values:
+#'
+#'    * `"overlap"` - This column is always included.
+#'    * `"concordance"` - includes `1` (concordant) and `-1` (discordant)
+#'    * `"agreement"` - includes `"agreement"` and `"disgreement"`
+#'    * `"each"` - includes sign values `-1` and `1`.
+#' 
+#' * `"overlap"` - integer vector with overlap values, where `0` and `1`
+#' indicate which sets contained these items. This column is always included,
+#' even when `overlap_type` is something else.
+#' * `"num_sets"` - integer number of sets represented in the overlap.
+#' * `"count"` - integer number of items in the overlap.
+#' * one colname for each set name represented in the `"sets"` column,
+#' intended to help filter by each set. Values will be `0` or `1`.
+#' * `overlap_label` - will represent only the non-0 elements from
+#' `"overlap"` for convenience.
+#' * `"items"` - when `return_items=TRUE` this column will contain
+#' a `list` (in `AsIs` format) of `character` vectors, with the items.
+#' 
+#' 
 #' @examples
 #' setlist <- make_venn_test(100, 2, do_signed=FALSE);
 #' 
@@ -119,6 +151,12 @@
 #' # check to verify
 #' signed_overlaps(inputlist, return_items=TRUE)$items
 #' 
+#' # test specific factor level order
+#' inputlist <- list(
+#'    setA=factor(c("A", "B", "D"), levels=c("D", "B", "A")),
+#'    setB=factor(c("A", "C", "E", "F")))
+#' signed_overlaps(inputlist, return_items=TRUE)
+#' 
 #' @export
 signed_overlaps <- function
 (setlist,
@@ -132,6 +170,8 @@ signed_overlaps <- function
  sep="&",
  trim_label=TRUE,
  include_blanks=TRUE,
+ keep_item_order=FALSE,
+ verbose=FALSE,
  ...)
 {
    ##
@@ -141,29 +181,43 @@ signed_overlaps <- function
    ## 1sec
    # convert setlist to signed incidence matrix
    #svims <- list2im_value(setlist, ...);
+
    if (inherits(setlist, "Matrix") || inherits(setlist, "matrix")) {
       svims <- setlist;
    } else {
       # handle list input
       setlist <- lapply(setlist, function(i){
          if (length(names(i)) == 0) {
-            if (is.numeric(i)) {
-               warning("signed_overlaps(): input list contains vector with un-named numeric values.");
+            ## No names, assume items are the elements
+            if (inherits(i, c("numeric", "integer"))) {
+               warning(paste("signed_overlaps():",
+                  "un-named numeric values coerced to character."));
             }
-            if (is.factor(i)) {
-               warning("signed_overlaps(): input list contains factor values which will be coerced to character.");
+            if (inherits(i, "factor")) {
+               warning(paste("signed_overlaps():",
+                  "factor values coerced to character."));
+               if (TRUE %in% keep_item_order) {
+                  i <- sort(i);
+               }
             }
             i <- jamba::nameVector(rep(1, length(i)),
                as.character(i),
                makeNamesFunc=c);
          } else {
+            ## Names exist, assume signed data
             if ("detect" %in% overlap_type) {
                # for "detect", convert numeric or integer input to sign(i)
-               if ( (is.numeric(i) || is.integer(i)) && !all(i %in% c(-1, 0, 1, NA)) ) {
+               if (inherits(i, c("numeric", "integer")) &&
+                     !all(i %in% c(-1, 0, 1, NA))) {
+                  # convert numeric values to the sign
                   i[] <- sign(i);
-               } else if (is.character(i) || is.factor(i)) {
+               } else if (inherits(i, c("character", "factor"))) {
+               # } else if (is.character(i) || is.factor(i)) {
                   if (!any(duplicated(i)) && length(i) > 3) {
-                     warning("signed_overlaps(): named character vector, non-duplicate items, length > 3, the vector values are used as items.");
+                     warning(paste("signed_overlaps():",
+                        "named character vector, non-duplicate items,",
+                        "length > 3.",
+                        "Values are used as items."));
                      i <- jamba::nameVector(rep(1, length(i)),
                         as.character(i),
                         makeNamesFunc=c);
@@ -174,6 +228,26 @@ signed_overlaps <- function
          i
       });
       svims <- list2im_value(setlist);
+      # optionally maintain item order
+      if (TRUE %in% keep_item_order) {
+         item_order_list <- lapply(setlist, names);
+         item_order <- unique(unlist(item_order_list));
+         matchims <- match(item_order, rownames(svims));
+         svims <- svims[matchims, , drop=FALSE];
+      }
+   }
+
+   if (!TRUE %in% keep_item_order) {
+      item_order <- jamba::mixedSort(rownames(svims));
+      matchims <- match(item_order, rownames(svims));
+      svims <- svims[matchims, , drop=FALSE];
+   }
+
+   # optional verbose output
+   if (TRUE %in% verbose) {
+      jamba::printDebug("signed_overlaps(): ",
+         "svims:");
+      print(svims);# debug
    }
 
    # handle overlap_type="detect"
@@ -191,26 +265,31 @@ signed_overlaps <- function
    ## 0.02sec
    # convert to overlap vector (signed)
    # 0 0 1, 1 1 0, 1 1 1, etc.
-   if (is.character(svims[1,1])) {
-      # if data is stored as character, change NA to ""
+   if (inherits(svims[1, 1], c("character", "factor"))) {
+      # if data is stored as character, recognize c("",NA) as empty
       svimsl <- (svims != "") * 1
+      # svimsl <- (!svims %in% c("", NA)) * 1; # new?
       svimsl[is.na(svims)] <- 0;
       svimss <- do.call(paste, lapply(seq_len(ncol(svims)), function(i){
-         jamba::rmNA(naValue="", svims[,i]);
+         jamba::rmNA(naValue="", svims[, i]);
       }))
    } else {
-      # if data is stored as numeric, change NA to "0"
+      # if data is stored as numeric, recognize c(0,NA) as empty
       svimsl <- (svims != 0) * 1
+      # svimsl <- (!svims %in% c(0, NA)) * 1; # new?
       svimsl[is.na(svims)] <- 0;
       svimss <- do.call(paste, lapply(seq_len(ncol(svims)), function(i){
-         jamba::rmNA(naValue="0", svims[,i]);
+         jamba::rmNA(naValue="0", svims[, i]);
       }))
    }
 
    ## 1.2sec
    # convert to overlap vector (un-signed)
    # 0 0 1, 1 1 0, 1 1 1, etc.
-   svimsv <- do.call(paste, lapply(seq_len(ncol(svimsl)), function(i){svimsl[,i]}))
+   svimsv <- do.call(paste,
+      lapply(seq_len(ncol(svimsl)), function(i){
+         svimsl[,i]
+      }))
 
    ## concordance
    ## 0.02sec
@@ -222,6 +301,22 @@ signed_overlaps <- function
       length(unique(j)) == 1;
    }), svimssu);
 
+   # optional verbose output
+   if (TRUE %in% verbose) {
+      jamba::printDebug("signed_overlaps(): ",
+         "svimsl:");
+      print(svimsl);# debug
+      jamba::printDebug("signed_overlaps(): ",
+         "svimss:");
+      print(svimss);# debug
+      jamba::printDebug("signed_overlaps(): ",
+         "svimsv:");
+      print(svimsv);# debug
+      jamba::printDebug("signed_overlaps(): ",
+         "svimssu:");
+      print(svimssu);# debug
+   }
+
    # alternate approach, split using overlap_type upfront, avoid data.table
    svims_split_names <- sapply(jamba::nameVector(unique(svimsv)), function(i){
       paste(collapse=sep,