add dscale_min, dscale_max

R/other_utils.R

@@ -16,15 +16,23 @@ col_widths <- function(m){
     1.1*max(do.call(grid::unit.c, lapply(l, grid::grobWidth)))))
 }
 
-scalecat <- function(m, n_cat=10, vmax=0.5){
-  if (min(m) == max(m)){
-    if (min(m) != 0){
-      m <- m/max(m)
+scalecat <- function(m, m_min=NULL, m_max=NULL, n_cat=10, vmax=0.5){
+  if (is.null(m_min)){
+    m_min = min(m)
+  }
+
+  if (is.null(m_max)){
+    m_max = max(m)
+  }
+
+  if (m_min == m_max){
+    if (m_min != 0){
+      m <- m/m_max
     } else {
       m <- m
     }
   } else {
-    m <- (m-min(m))/(max(m) - min(m))
+    m <- (m-m_min)/(m_max - m_min)
   }
   
   m <- apply(m, 1:2, function(x) round(x*n_cat)/(n_cat/vmax))

R/table_extra.R

@@ -23,6 +23,7 @@
 #' @examples
 #' library(tableExtra)
 extra_table_grob <- function(dscale, dcolor=NULL,
+                             dscale_min=NULL, dscale_max=NULL,
                              rows=rownames(dscale), cols=colnames(dscale), 
                              rows_more=NULL, cols_more=NULL,
                              rows_more_title="",
@@ -41,6 +42,8 @@ extra_table_grob <- function(dscale, dcolor=NULL,
                     padding=theme$core$padding,
                     n_cat=theme$core$n_cat,
                     r_max=0.5*theme$core$size,
+                    dscale_min=dscale_min,
+                    dscale_max=dscale_max,
                     pal=theme$core$pal,
                     pal_breaks=theme$core$pal_breaks,
                     dcolor=dcolor)

R/table_params.R

@@ -29,8 +29,8 @@ table_params <- function(d, fg_params, bg_params){
 #'
 #' @author Yoann Pradat
 #' @keywords internal
-table_params_circle_scale <- function(d, n_cat=10, r_max=unit(10, "mm")){
-  d <- scalecat(d, n_cat=n_cat, vmax=1)
+table_params_circle_scale <- function(d, n_cat=10, r_max=unit(10, "mm"), d_min=NULL, d_max=NULL){
+  d <- scalecat(d, d_min, d_max, n_cat=n_cat, vmax=1)
   d <- as.vector(d)
   params <- list(r=do.call(unit.c, lapply(d, function(x) x*r_max)))
   return(params)
@@ -81,8 +81,11 @@ table_params_circle_color <- function(d, pal, pal_breaks=NULL){
 #'
 #' @author Yoann Pradat
 #' @keywords internal
-table_params_circle <- function(dscale, dcolor, n_cat, r_max, pal, pal_breaks){
-  params_scale <- table_params_circle_scale(d=dscale, n_cat=n_cat, r_max=r_max)
+table_params_circle <- function(dscale, dcolor, n_cat, r_max, pal, pal_breaks, dscale_min=NULL, dscale_max=NULL){
+  if (missing(dscale_min)){
+    print("dscale is missing")
+  }
+  params_scale <- table_params_circle_scale(d=dscale, n_cat=n_cat, r_max=r_max, d_min=dscale_min, d_max=dscale_max)
 
   if(!missing(dcolor)){
     params_color <- table_params_circle_color(d=dcolor, pal=pal, pal_breaks=pal_breaks)