Silenced unintended verbose output, minor adjustes to label positioni…

…ng logic.
jmw86069 · Sep 30, 2024 · 2e4481d · 2e4481d
1 parent b9bc0a1
commit 2e4481d
Show file tree

Hide file tree

Showing 41 changed files with 159 additions and 65 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: venndir
 Title: Directional Venn diagrams
-Version: 0.0.39.950
+Version: 0.0.40.900
 Authors@R: c(
     person(given="James M.",
        family="Ward",

diff --git a/NAMESPACE b/NAMESPACE
@@ -1,6 +1,5 @@
 # Generated by roxygen2: do not edit by hand
 
-S3method(plot,JamPolygon)
 export(add_orientation_JamPolygon)
 export(area_JamPolygon)
 export(bbox_JamPolygon)
@@ -39,6 +38,7 @@ export(nearest_point_JamPolygon)
 export(nudge_JamPolygon)
 export(nudge_venndir_label)
 export(overlaplist2setlist)
+export(plot.JamPolygon)
 export(point_in_JamPolygon)
 export(polyclip_to_JamPolygon)
 export(polygon_circles)

diff --git a/NEWS.md b/NEWS.md
@@ -1,3 +1,8 @@
+# venndir 0.0.40.900
+
+* Updated label positioning logic, silenced some unintended verbose output
+from `render_venndir()`.
+
 # venndir 0.0.39.950
 
 * Small change to use `gridGeometry` 0.4.1 from Github until released to CRAN,

diff --git a/R/venndir-grob-assembly.R b/R/venndir-grob-assembly.R
@@ -604,6 +604,7 @@ grobs_yalign <- function
 
    ## define x reference coordinate for alignment
    if (verbose) {
+      jamba::printDebug("ref_grob: ", ref_grob);
       jamba::printDebug("yext_init:");print(yext_init);
    }
    if (length(use_y) > 0) {

diff --git a/R/venndir-label-style.R b/R/venndir-label-style.R
@@ -828,12 +828,18 @@ venndir_label_style <- function
 
    # vjust does y-axis justification
    #   (0=above point, 1=below point, 0.5=centered)
-   venndir_output$label_df$vjust_outside <- ifelse(venndir_output$label_df$type %in% "main",
-      1 - llo_adjy,
-      venndir_output$label_df$vjust);
-   venndir_output$label_df$vjust_inside <- ifelse(venndir_output$label_df$type %in% "main",
-      1 - lli_adjy,
-      venndir_output$label_df$vjust);
+   if (FALSE) {
+      venndir_output$label_df$vjust_outside <- ifelse(venndir_output$label_df$type %in% "main",
+         1 - llo_adjy,
+         venndir_output$label_df$vjust);
+      venndir_output$label_df$vjust_inside <- ifelse(venndir_output$label_df$type %in% "main",
+         1 - lli_adjy,
+         venndir_output$label_df$vjust);
+   } else {
+      # test
+      venndir_output$label_df$vjust_outside <- venndir_output$label_df$vjust;
+      venndir_output$label_df$vjust_inside <- venndir_output$label_df$vjust;
+   }
 
    # toupdate
    toupdate <- venndir_output$label_df$type %in% label_types;

diff --git a/R/venndir-labels.R b/R/venndir-labels.R
@@ -87,7 +87,8 @@ draw_gridtext_groups <- function
       # adjust_centered=FALSE turns off adjustment for adj=0.5
       #
       # adapted from gridtext::richtext_grob() internals
-      if (verbose) {
+      # if (all(c(1,2,3) %in% k)) { verbose <- TRUE }
+      if (verbose > 1) {
          jamba::printDebug("draw_gridtext_groups(): ",
             "grob_group_roundrect(),  k:", k);
          print(head(gdf[k,,drop=FALSE]));
@@ -98,7 +99,10 @@ draw_gridtext_groups <- function
          use_groupdf <- groupdf[k, , drop=FALSE];
          k_childnames <- use_groupdf$childName;
          k <- match(k_childnames, grid::childNames(g_labels));
-         # jamba::printDebug("use_groupdf:");print(use_groupdf);# debug
+         if (verbose > 1) {
+            jamba::printDebug("draw_gridtext_groups(): ",
+               "grob_group_roundrect(), use_groupdf:");print(use_groupdf);# debug
+         }
       }
 
       ## Experimental realign strategy
@@ -110,6 +114,11 @@ draw_gridtext_groups <- function
          is_signed_count <- (grepl("count", use_groupdf$type) &
                grepl("signed", use_groupdf$counttype));
          is_overlap_label <- (grepl("overlap", use_groupdf$type));
+         if (verbose > 1) {
+            jamba::printDebug("draw_gridtext_groups(): ",
+               "grob_group_roundrect(), params:");
+            print(data.frame(is_main_count, is_signed_count, is_overlap_label));# debug
+         }
 
          use_segment_df <- head(segment_df, 0);
          if ("label_group" %in% colnames(segment_df)) {
@@ -132,8 +141,6 @@ draw_gridtext_groups <- function
          # - assemble overlap and count labels top to bottom: grobs_stack()
          #    - center-align: grobs_xalign()
 
-         # all_g_labels_cns <- grid::childNames(g_labels);
-         # jamba::printDebug("all_g_labels_cns:");print(data.frame(all_g_labels_cns));# debug
          g_labels_cns <- use_groupdf$childName;
          # jamba::printDebug("g_labels_cns:");print(g_labels_cns);# debug
          use_vp <- NULL;
@@ -229,20 +236,31 @@ draw_gridtext_groups <- function
             use_y <- grid::unit(adjy_fn(head(gdf$y[korig], 1)), "snpc");
          }
          # jamba::printDebug("adjx:", adjx, ", adjy:", adjy);# debug
-         # jamba::printDebug("use_xalign:", use_xalign, ", use_yalign:", use_yalign);# debug
+         if (verbose) jamba::printDebug("use_xalign:", use_xalign, ", use_yalign:", use_yalign);# debug
          # jamba::printDebug("adjy_fn(use_segment_df$y):");print(adjy_fn(use_segment_df$y));
          # ge1 <- grobs_exts(gt_final);
          # jamba::printDebug("ge1:");print(ge1);
          # newgrob
          gt_final2 <- grobs_xalign(xalign=use_xalign,
             use_x=use_x,
             grobs_yalign(yalign=use_yalign,
+               verbose=verbose,
                use_y=use_y,
                list(gt_final)))
          gt_final <- gt_final2;
-
+         if (verbose > 1) {
+            jamba::printDebug("str(gt_final):");
+            print(str(gt_final, max.level=3));# debug
+         }
+
          ## Now create roundrectGrob to bind them
          scm_exts <- grobs_exts(gt_final)
+         if (verbose) {
+            # jamba::printDebug("scm_exts:");
+            # print(str(scm_exts, max.level=5));# debug
+            jamba::printDebug("length(scm_exts$xext):");
+            print(length(scm_exts$xext));# debug
+         }
          scm_exts_x <- (scm_exts$xext[[1]] + scm_exts$xext[[2]]) / 2;
          scm_exts_y <- (scm_exts$yext[[1]] + scm_exts$yext[[2]]) / 2;
          scm_exts_w <- (scm_exts$xext[[2]] - scm_exts$xext[[1]]);
@@ -477,7 +495,6 @@ draw_gridtext_groups <- function
    }
    gdf_split <- split(gdf$num, gdf_group);
    # jamba::printDebug("gdf:");print(gdf);# debug
-   # jamba::printDebug("gdf:");print(gdf);# debug
    # jamba::printDebug("head(gdf_split, 2):");print(head(gdf_split, 2));# debug
    # jamba::printDebug("unique(segment_df):");print(unique(segment_df));# debug
 
@@ -496,15 +513,16 @@ draw_gridtext_groups <- function
    }));
    rownames(adj_df) <- names(gdf_split);
    # jamba::printDebug("adj_df:");print(adj_df);# debug
-
+   # jamba::printDebug("gdf_group:");print(gdf_group);# debug
    rr_grobs <- list();
    new_g_labels <- list();
    #rr_grobs <- lapply(split(gdf$num, gdf_group), function(k){
    for (ki in seq_along(gdf_split)) {
       k <- gdf_split[[ki]];
       # determine if any labels have a line segment
       kgroup <- gdf_group[k][1];
-      # jamba::printDebug("adj_df[kgroup, ]:");print(adj_df[kgroup, ]);
+      # jamba::printDebug("k:");print(k);# debug
+      # jamba::printDebug("adj_df[kgroup, ]:");print(adj_df[kgroup, ]);# debug
       # jamba::printDebug("prior to grob_group_roundrect() childNames(g_labels):");print(childNames(g_labels));# debug
       rr_grob_l <- grob_group_roundrect(
          g_labels=g_labels,

diff --git a/R/venndir-render-jp.R b/R/venndir-render-jp.R
@@ -57,6 +57,8 @@
 #'    `grid::grid.newpage()`. This option allows the figure to be rendered
 #'    inside an active display device, or active `grid::viewport`.
 #'    Note: When `do_draw=FALSE`, it also forces `do_newpage=FALSE`.
+#' @param verbose `logical` indicating whether to print verbose output.
+#' @param ... additional arguments are passed to internal functions.
 #' 
 #' @returns `Venndir` object with attributes that contain underlying
 #'    `grid` graphical objects (grobs):
@@ -114,6 +116,7 @@ render_venndir <- function
  do_newpage=TRUE,
  do_draw=TRUE,
  draw_buffer=FALSE,
+ verbose=FALSE,
  ...)
 {
    # validate input
@@ -477,7 +480,7 @@ render_venndir <- function
                y1=test_xy$y1,
                jp=jp_list,
                buffer=test_xy$segment_buffer,
-               verbose=FALSE,
+               verbose=verbose,
                ...);
             rownames(new_xy) <- names(sp_index);
             # jamba::printDebug("new_xy:");print(new_xy);# debug
@@ -591,7 +594,7 @@ render_venndir <- function
             degrees=items_df1$item_degrees[1],
             buffer=item_buffer,
             seed=123,
-            verbose=TRUE,
+            verbose=verbose,
             ...);
          if (length(lpf) == 0) {
             return(lpf)
@@ -955,6 +958,8 @@ render_venndir <- function
                vjust=igdf$vjust,
                hjust=igdf$hjust,
                halign=igdf$halign,
+               # valign=igdf$valign,
+               valign=0.5,
                rot=igdf$rot,
                padding=grid::unit(igdf$padding,
                   igdf$padding_unit),
@@ -974,9 +979,7 @@ render_venndir <- function
                   lty=igdf$box_lty,
                   lwd=igdf$box_lwd)
             );
-            # attempt to re-assign custom childNames to the grobs
-            # jamba::printDebug("childNames(g_labels):");print(childNames(g_labels));# debug
-            # jamba::printDebug("igdf:");print(igdf);# debug
+            # re-assign custom childNames to the grobs
             new_childNames <- paste0(
                igdf$overlap_set, ":",
                igdf$type, ":",
@@ -987,18 +990,15 @@ render_venndir <- function
                grid::getGrob(g_labels, iname);
             })
             names(templist) <- new_childNames;
+            # jamba::printDebug("names(templist):");print(names(templist));# debug
             templist
-            # tempgList <- do.call(grid::gList, templist);
-            # g_labels <- grid::setChildren(g_labels, children=tempgList)
-            # # g_labels$childrenOrder <- jamba::nameVector(new_childNames);
-            # jamba::printDebug("childNames(g_labels):");print(childNames(g_labels));# debug
-            # g_labels;
          });
          # grid::popViewport();
          # assemble g_labels_list into gTree
          g_labels_gTree <- grid::grobTree(
             vp=jp_viewport,
-            do.call(grid::gList, unlist(unname(g_labels_list), recursive=FALSE)),
+            do.call(grid::gList,
+               unlist(unname(g_labels_list), recursive=FALSE)),
             name="labels");
          # jamba::printDebug("names(grid::childNames(g_labels_gTree)):");print(names(grid::childNames(g_labels_gTree)));# debug
          g_labels_groupdf <- data.frame(check.names=FALSE,
@@ -1031,10 +1031,10 @@ render_venndir <- function
                   groupdf=g_labels_groupdf,
                   segment_df=unique(segment_df),
                   adjust_center=adjust_center,
-                  adjx=adjx,
-                  adjy=adjy,
+                  adjx_fn=adjx,
+                  adjy_fn=adjy,
                   do_draw=FALSE,
-                  verbose=FALSE)
+                  verbose=verbose)
                # dgg$g_labels;
                dgg
             }, error=function(e){

diff --git a/R/venndir-shrinkdf.R b/R/venndir-shrinkdf.R
@@ -14,6 +14,27 @@
 #' 
 #' @import data.table
 #' 
+#' @examples
+#' testdf <- data.frame(check.names=FALSE,
+#'    SYMBOL=rep(c("ACTB", "GAPDH", "PPIA"), c(2, 3, 1)),
+#'    `logFC B-A`=c(1.4, 1.4, 2.3, NA, 2.3, 5.1),
+#'    probe=paste0("probe", 1:6))
+#' shrink_df(testdf, by="SYMBOL", num_func=function(x){mean(x, na.rm=TRUE)})
+#' 
+#' testdftall <- do.call(rbind, lapply(1:10000, function(i){
+#'    idf <- testdf;
+#'    idf$SYMBOL <- paste0(idf$SYMBOL, "_", i);
+#'    idf;
+#' }))
+#' head(testdftall, 12)
+#' shrunk_tall <- shrink_df(testdftall,
+#'    by="SYMBOL",
+#'    num_func=function(x){mean(x, na.rm=TRUE)})
+#' 
+#' shrunk_tall2 <- jamses::shrinkDataFrame(testdftall,
+#'    groupBy="SYMBOL")
+#' head(shrunk_tall2, 12)
+#' 
 #' @export
 shrink_df <- function
 (df,

diff --git a/TODO.md b/TODO.md
@@ -1,5 +1,23 @@
 # TODO for venndir
 
+## 13sep2024
+
+* Adjust aesthetics based upon feedback.
+
+   * The arrows could be larger relative to the signed counts.
+   * Consider removing the colon `":"` between arrows and signed counts.
+   * When adjusting arrow/signed count font sizes, the text is bottom-aligned,
+   should probably be middle (top-middle-bottom) aligned.
+
+      * Using `vjust=0.5` caused signed labels not to be grouped properly.
+
+## 04sep2024
+
+* Fix bug when `names(setlist)` contains parentheses, causing the set
+name to appear inside the polygon. Removing the parentheses fixes
+the problem, but unclear why this happens? Probably errant `grep()`
+call somewhere.
+
 ## 28aug2024
 
 * Need some way to move outside labels to the top (or bottom),

diff --git a/man/JamPolygon-class.Rd b/man/JamPolygon-class.Rd
diff --git a/man/JamPolygon-methods.Rd b/man/JamPolygon-methods.Rd
diff --git a/man/Venndir-class.Rd b/man/Venndir-class.Rd
diff --git a/man/add_orientation_JamPolygon.Rd b/man/add_orientation_JamPolygon.Rd
diff --git a/man/area_JamPolygon.Rd b/man/area_JamPolygon.Rd
diff --git a/man/bbox_JamPolygon.Rd b/man/bbox_JamPolygon.Rd
diff --git a/man/buffer_JamPolygon.Rd b/man/buffer_JamPolygon.Rd
diff --git a/man/check_JamPolygon.Rd b/man/check_JamPolygon.Rd