v1.1.8

Add:

- Citation information while loading itol.toolkit package

- Color distance calculation and gradient color generation

- Color generation by two factors

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: itol.toolkit
 Title: Helper Functions for 'Interactive Tree Of Life'
-Version: 1.1.7
+Version: 1.1.8
 Authors@R: 
     person(
     given = "Tong",
@@ -45,10 +45,12 @@ Depends:
 LazyData: true
 Collate: 
     'addins.R'
+    'color.R'
     'data.R'
     'learn.R'
     'object.R'
     'utils.R'
     'output.R'
     'user.R'
     'ops.R'
+    'zzz.R'

NAMESPACE

@@ -1,5 +1,6 @@
 # Generated by roxygen2: do not edit by hand
 
+export(color_distance)
 export(complex_html_text)
 export(convert_01)
 export(convert_01_to_connect)
@@ -16,6 +17,7 @@ export(file_get_dir)
 export(file_get_name)
 export(file_to_unit)
 export(get_color)
+export(gradient_color)
 export(head_line)
 export(hub_to_unit)
 export(learn_data)
@@ -86,6 +88,8 @@ importFrom(dplyr,case_when)
 importFrom(dplyr,left_join)
 importFrom(dplyr,mutate_all)
 importFrom(grDevices,boxplot.stats)
+importFrom(grDevices,col2rgb)
+importFrom(grDevices,colorRampPalette)
 importFrom(methods,is)
 importFrom(methods,new)
 importFrom(purrr,discard)

R/color.R

@@ -0,0 +1,60 @@
+#' Color distance
+#' @description calculate distance between two color in hex or rgb format. rgb
+#' maxColorValue = 255.
+#' @param color_1 color 1 in hex or rgb format
+#' @param color_2 color 2 in hex or rgb format
+#' @importFrom grDevices col2rgb
+#' @return a distance number
+#' @export
+color_distance <- function(color_1,color_2){
+  if(grepl("^#",color_1[1])){
+    color_1 <- col2rgb(color_1)
+  }
+  if(grepl("^#",color_2[1])){
+    color_2 <- col2rgb(color_2)
+  }
+  R1 <- color_1[1]
+  G1 <- color_1[2]
+  B1 <- color_1[3]
+  R2 <- color_2[1]
+  G2 <- color_2[2]
+  B2 <- color_2[3]
+  Rmean <- (R1 + R2)/2
+  R <- R1 - R2
+  G <- G1 - G2
+  B <- B1 - B2
+  dis <- sqrt((2+Rmean/256)*(R**2)+4*(G**2)+(2+(255-Rmean)/256)*(B**2))
+  return(dis)
+}
+
+#' Generate gradient colors
+#' @description generate a vector of gradient colors by start, mid, and end
+#' colors.
+#' @param n the length of vector
+#' @param start start color in hex format
+#' @param mid mid color in hex format, default is null.
+#' @param end end color in hex format, default is white.
+#' @importFrom grDevices colorRampPalette
+#' @return a vector of gradient colors
+#' @export
+gradient_color <- function(n,start,mid=NULL,end="#FFFFFF"){
+  if(is.null(mid)){
+    if(color_distance(end,"#FFFFFF")<10){
+      fun_colors <- colorRampPalette(c(start, end))
+      colors <- fun_colors(6)
+      end <- colors[5]
+    }
+    fun_colors <- colorRampPalette(c(start, end))
+    colors <- fun_colors(n)
+  }else{
+    if(color_distance(end,"#FFFFFF")<10){
+      fun_colors <- colorRampPalette(c(mid, end))
+      colors <- fun_colors(6)
+      end <- colors[5]
+    }
+    fun_colors_1 <- colorRampPalette(c(start, mid))
+    fun_colors_2 <- colorRampPalette(c(mid, end))
+    colors <- c(fun_colors_1(n/2),fun_colors_2(n/2))
+  }
+  return(colors)
+}

R/learn.R

@@ -1477,7 +1477,7 @@ train_theme <- function(dir=getwd()){
   theme_default_connection <- object_default@theme$example_connections
   theme_default_image <- object_default@theme$example_image_dataset
   theme_default_popup <- object_default@theme$popup_info_template
-  inbuilt_themes <<- list(
+  inbuilt_themes <- list(
     COLLAPSE = list(default = theme_default_collapse),
     PRUNE = list(default = theme_default_prune),
     SPACING = list(default = theme_default_spacing),
@@ -1502,6 +1502,7 @@ train_theme <- function(dir=getwd()){
     DATASET_IMAGE = list(default = theme_default_image),
     POPUP_INFO = list(default = theme_default_popup)
   )
+  eval(parse(text = "inbuilt_themes <<- inbuilt_themes"))
 }
 
 

R/user.R

@@ -1148,16 +1148,37 @@ create_unit <- function(data,key,type,style="default",subtype=NULL,color=NULL,li
   if(type == "DATASET_DOMAINS"){
     shape_by = NULL
     if(length(names(data)) == 3){
-      data <- data[order(data[[2]],data[[3]]),]
-      shape_by <- factor(pull(data[,2]),levels = unique(pull(data[,2])))
-      print(shape_by)
-      levels(shape_by) <- c("RE","HH","HV","EL","DI","TR","TL","PL","PR","PU","PD","OC","GP")[1:length(levels(shape_by))]
-      shape = shape_by
-            print(shape)
-      data <- data[,-2]
-      data[,2] <- factor(pull(data[,2]),levels = unique(pull(data[,2])))
-    }
-    if(length(names(data)) == 2){
+      if(is.null(shape)){
+        data <- data[order(data[[2]],data[[3]]),]
+        shape_by <- factor(pull(data[,2]),levels = unique(pull(data[,2])))
+        levels(shape_by) <- c("RE","HH","HV","EL","DI","TR","TL","PL","PR","PU","PD","OC","GP")[1:length(levels(shape_by))]
+        shape = shape_by
+        data <- data[,-2]
+        data[,2] <- factor(pull(data[,2]),levels = unique(pull(data[,2])))
+      }else{
+        data <- data[order(data[[2]],data[[3]]),]
+        color_by <- factor(pull(data[,2]),levels = unique(pull(data[,2])))
+        if(color %in% get_color(set="ls")){
+          levels(color_by) <- get_color(n=length(levels(color_by)),set = color)
+        }else{
+          stop("The color parameter should be within get_color sets.")
+        }
+        data_with_colors <- data.frame()
+        for (i in 1:length(levels(color_by))) {
+          sub_data <- data[which(data[,2]==unique(pull(data[,2]))[i]),]
+          n = length(unique(pull(sub_data[,3])))
+          sub_color_by <- gradient_color(n,levels(color_by)[i])
+          sub_data$colors <- factor(pull(sub_data[,3]),levels = unique(pull(sub_data[,3])))
+          levels(sub_data$colors) <- sub_color_by
+          sub_data <- sub_data[,-2]
+          sub_data[,2] <- factor(pull(sub_data[,2]),levels = unique(pull(sub_data[,2])))
+          data_with_colors <- rbind(data_with_colors,sub_data)
+        }
+        data <- data_with_colors
+        color = data$colors
+      }
+    }
+    if(length(names(data)) %in% c(2,3)){
       data <- data.frame(data,length=rep(10,nrow(data)),start=rep(0,nrow(data)),end=rep(10,nrow(data)))
     }
     length = NULL
@@ -1244,12 +1265,17 @@ create_unit <- function(data,key,type,style="default",subtype=NULL,color=NULL,li
           }
         }
       }
+    }else{
+      if("colors"%in%names(data)){
+        colname_color = "colors"
+        color = data$colors
+      }
     }
     colname_data <- names(data)[!names(data)%in%c("id", colname_length, colname_shape, colname_start, colname_end, colname_color)]
     if(length(color) != nrow(data)){
       message("Identifying data column to auto setup color parameter")
       if(length(colname_data)!=1){
-        stop("Unable to indentify data column")
+        #stop("Unable to indentify data column")
       }
     }
     if(is.null(color)){

R/zzz.R

@@ -0,0 +1,15 @@
+.onAttach <- function(libname, pkgname) {
+  packageStartupMessage(
+    "
+
+itol.toolkit v1.1.7 For help: https://tongzhou2017.github.io/itol.toolkit
+
+If you use the itol.toolkit package in published research, please cite:
+
+Zhou, T., Xu, K., Zhao, F., Liu, W., Li, L., Hua, Z., & Zhou, X. (2023).
+itol.toolkit accelerates working with iTOL (Interactive Tree of Life)
+by an automated generation of annotation files. Bioinformatics, 39(6), btad339.
+
+"
+  )
+}

README.md

@@ -86,7 +86,7 @@ write_hub(hub,getwd())
 
 ## Documents
 
-We have documents for every single function and some important tips for users. We also provided a ChatBot to help users learn the package interactively on [Chat Thing](https://chatthing.ai/bots/4de00ca8-a0f6-4e2d-8bd7-da65f10dc688/) and [Slack](https://join.slack.com/t/itoltoolkit/shared_invite/zt-1u3scgzlw-EwUG_axGTTSq9CrDmVRSDQ).
+We have documents for every single function and some important tips for users. We also provided a ChatBot to help users learn the package interactively on [Chat Thing](https://chatthing.ai/bots/4de00ca8-a0f6-4e2d-8bd7-da65f10dc688/).
 
 ### Single functions