Merge pull request #44 from LotharukpongJS/master

Added `tfPS()` function and some further touch-up

DESCRIPTION

@@ -66,8 +66,8 @@ LinkingTo:
     cpp11,
     RcppThread, 
     RcppEigen
-URL: https://github.com/drostlab/myTAI
+URL: https://drostlab.github.io/myTAI/
 BugReports: https://github.com/drostlab/myTAI/issues
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.2
 Encoding: UTF-8
 SystemRequirements: C++

NAMESPACE

@@ -64,6 +64,7 @@ export(rhScore)
 export(taxid)
 export(taxonomy)
 export(tf)
+export(tfPS)
 export(tfStability)
 import(Matrix)
 import(Rcpp)

R/age.apply.R

@@ -13,7 +13,7 @@
 #' be performed to the sub-matrices. The return value of this function is a numeric matrix storing
 #' the return values by \code{FUN} for each phylostratum and each developmental stage s. 
 #' Note that the input \code{FUN} must be an function that can be applied to a matrix (e.g., \code{\link{colMeans}} or \code{\link{RE}}). 
-#' In case you use an an anymous function you coud use \code{function(x) apply(x , 2 , var)} as an example to compute the variance of each phylostratum and each
+#' In case you use an anonymous function you could use \code{function(x) apply(x , 2 , var)} as an example to compute the variance of each phylostratum and each
 #' developmental stage s.
 #' @return Either a numeric matrix storing the return values of the applied function for each age class
 #' or a numeric list storing the return values of the applied function for each age class in a list.

R/base.R

@@ -62,6 +62,7 @@ re.colors <- function(n)
 #' 
 #' # get 5 different colors for 5 different bars
 #' barplot_colors <- bar.colors(5)
+#' @keywords internal
 #' @export
 bar.colors <- function(n)
 {

R/is.ExpressionSet.R

@@ -8,7 +8,7 @@
 #' data(PhyloExpressionSetExample)
 #' 
 #' is.ExpressionSet(PhyloExpressionSetExample)
-#' 
+#' @keywords internal
 #' @export
 is.ExpressionSet <- function(ExpressionSet){
 

R/tf.R

@@ -153,9 +153,6 @@ tf <- function(ExpressionSet, FUN, pseudocount = 0, integerise = FALSE){
 
         res_mat <- f(ExpressionMatrix)
 
-        # res <- tibble::rownames_to_column(base::as.data.frame(res_mat), base::colnames(ExpressionSet)[2])
-        # res <- ExpressionSet[ , 1:2] %>% dplyr::right_join(res, by = "GeneID") # too slow.
-        # res <- base::cbind(ExpressionSet[ , 1], res)
         res <- base::cbind(ExpressionSet[ , c(1,2)], base::as.data.frame(res_mat))
         return(res)
 }

R/tfPS.R

@@ -0,0 +1,65 @@
+#' @title Transform Phylostratum Values
+#' @description 
+#' This function performs transformation of phylostratum values.
+#' 
+#' @param ExpressionSet a standard PhyloExpressionSet object.
+#' @param transform a character vector of any valid function that transforms PS values.
+#' Possible values can be:
+#' \itemize{
+#' \item \code{transform} = \code{"qr"} (or \code{"quantilerank"}) : 
+#' quantile rank transformation analogous to Julia function \code{StatsBase.quantilerank} 
+#' using \code{method = :tied}.
+#' }
+#' @details This function transforms the phylostratum assignment. 
+#' The return value of this function is a PhyloExpressionSet object with 
+#' transformed phylostratum \code{tfPhylostratum} as the first column, satisfying
+#' \code{\link{is.ExpressionSet}}. Note that the input \code{transform} must be an
+#' available function, currently limited to only \code{"qr"} (or \code{"quantilerank"}).
+#' @return a standard PhloExpressionSet object storing transformed Phylostratum levels.
+#' @author Jaruwatana Sodai Lotharukpong and Lukas Maischak
+#' @seealso \code{\link{tf}}
+#' @examples
+#' # source the example dataset
+#' data(PhyloExpressionSetExample)
+#'  
+#' # get the relative expression profiles for each phylostratum
+#' tfPES <- tfPS(PhyloExpressionSetExample, transform = "qr")
+#' head(tfPES)
+#'
+#' @export
+
+tfPS <- function(ExpressionSet,transform){
+  ExpressionSet <- as.data.frame(ExpressionSet)
+  is.ExpressionSet(ExpressionSet)
+
+  PS_vector <- ExpressionSet[,1]
+
+  if(transform %in% c("qr", "quantilerank")){
+    ranks <- base::rank(PS_vector, ties.method = "average")
+    # using the tied method
+    tfPhylostratum <- (ranks - 0.5) / length(PS_vector)
+  }else{
+    stop("Choose the following transformation functions: \"qr\"")
+  }
+
+  # We are only using "tied". 
+  # Below are other methods for quantile rank transform,
+  # from Julia's StatsBase.quantilerank
+
+  # n <- length(PS_vector)
+  # if (method == "inc") {tfPhylostratum <- (ranks - 1) / (n - 1)} 
+  # else if (method == "exc") {tfPhylostratum <- ranks / (n + 1)}
+  # else if (method == "compete") {tfPhylostratum <- (ranks - 1) / (n - 1)} 
+  # else if (method == "tied") {tfPhylostratum <- (ranks - 0.5) / n}
+  # else if (method == "strict") {tfPhylostratum <- (ranks - 1) / n}
+  # else if (method == "weak") {tfPhylostratum <- ranks / n} 
+  # else {
+  #   stop("method=", method, " is not valid. Pass 'inc', 'exc', 'compete', 'tied', 'strict', or 'weak'.")
+  # }
+
+  res <- base::cbind(
+    base::as.data.frame(tfPhylostratum), 
+    ExpressionSet[ , -1])
+
+  return(res)
+}

README.md

@@ -123,7 +123,7 @@ ExprExample <- tf(PhyloExpressionSetExample, log2)
 PlotSignature(ExprExample)
 ```
 
-![](man/figures/unnamed-chunk-10-1.png)
+![plotSignature](man/figures/unnamed-chunk-10-1.png)
 
 
 #### Quantify expression level distributions for each gene age category
@@ -134,7 +134,7 @@ PlotSignature(ExprExample)
 PlotCategoryExpr(ExprExample, "PS")
 ```
 
-![](man/figures/unnamed-chunk-11-1.png)
+![plotCategoryExpr](man/figures/unnamed-chunk-11-1.png)
 
 #### Quantify mean expression of individual gene age categories
 
@@ -144,7 +144,7 @@ PlotCategoryExpr(ExprExample, "PS")
 PlotMeans(ExprExample, Groups = list(1:3, 4:12))
 ```
 
-![](man/figures/unnamed-chunk-12-1.png)
+![plotMeans](man/figures/unnamed-chunk-12-1.png)
 
 
 #### Quantify relative mean expression of each age category seperated by old versus young genes
@@ -155,7 +155,7 @@ PlotMeans(ExprExample, Groups = list(1:3, 4:12))
 PlotRE(ExprExample, Groups = list(1:3, 4:12))
 ```
 
-![](man/figures/unnamed-chunk-13-1.png)
+![plotRE](man/figures/unnamed-chunk-13-1.png)
 
 ```r
 # plot the significant differences between gene expression distributions 
@@ -266,6 +266,7 @@ All functions also include visual analytics tools to quantify the goodness of te
 
 * `MatchMap()` : Match a Phylostratigraphic Map or Divergence Map with a ExpressionMatrix
 * `tf()` : Transform Gene Expression Levels
+* `tfPS()` : Transform Phylostratum Levels
 * `tfStability()` : Perform Permutation Tests Under Different Transformations
 * `age.apply()` : Age Category Specific apply Function
 * `ecScore()` : Compute the Hourglass Score for the EarlyConservationTest