utils::globalVariables(".")
utils::globalVariables("geneSimData")
utils::globalVariables("refnet_index")
utils::globalVariables("NFP_sim")
.check.NFP <- function(object){
if(!is(object, "NFP")) stop("object has to be of class \"NFP\" ")
errors <- character()
if (!is.numeric(object@raw_score))
errors <- c(errors, "raw_score must be a numeric")
if (!is.data.frame(object@randomized_score))
errors <- c(errors, "randomzid_score must be a character")
if(!is.numeric(object@standardized_score))
errors <- c(errors, "standardized_score must be a numeric")
if(!is.list(object@cluster))
errors <- c(errors, "name must be a list")
##if(!is.character(object@refnet_names))
##errors <- c(errors, "refnet_names must be a character")
##if(!is.character(object@group))
##errors <- c(errors, "group must be a character")
if(length(errors) == 0)
TRUE
else
errors
}
#'\code{NFP-class}
#'
#'An S4 object for storing network fingerprint similarity score information.
#'
#'@slot raw_score, a numeric vector, network fingerprint based on reference
#'networks before standardization.
#'@slot randomized_score, a data frame, the permulated similarity score.
#'@slot standardized_score, a numeric vector, the final standardized network fingerprint.
#'@slot cluster, an \emph{APResult} list, more details see package **apcluster**,
#'each element provides a cluster information of a
#'biological network based on one reference networks.
#' #'@section method:
#' \itemize{
#' \item{perm_score, \code{signature(object = "NFP")}:
#' extract the randomized similarity score}
#' \item{cluster_info, \code{signature(object = "NFP")}:
#' extract the cluster information}
#' \item{sub_NFP, \code{signature(object = "NFP")}:
#' subset of NFP object}
#' \item{plot, \code{signature(object, type = "character", p_size = "numeric", l_size = 'numeric')}:
#' plot NFP results}
#' \item{show, \code{signature(object = "NFP")}:
#' display methods for S4 classes NFP, see also
#' \code{\link[methods]{show}}}
#' }
#'
#' @name NFP-class
#' @rdname NFP-class
#' @exportClass NFP
#' @seealso \code{\link{show-methods}},
#' \code{\link{plot-methods}}, \code{\link{perm_score-methods}},
#' \code{\link{cluster_info-methods}}, \code{\link{sub_NFP-methods}}
#'
setClass("NFP", slot=list(raw_score = "numeric", randomized_score = 'data.frame',
standardized_score = "numeric",cluster = "list"),
prototype = list(raw_score = numeric(0), randomized_score = NULL,
standardized_score = numeric(0), cluster = NULL))
#' Extract the randomized similarity score
#'
#' This function extract the randomized similarity score for standardization.
#'
#'@exportMethod perm_score
#'@rdname perm_score-methods
#'@name perm_score-methods
#'@param object, \code{NFP} class
#'@aliases perm_score perm_score-methods
#'@docType methods
#'@seealso \code{\link{NFP}}
#'@return a data frame, each col (elements) represents once permutation
#'similarity score, each row indicate a reference basic network.
setGeneric("perm_score",
function(object){standardGeneric("perm_score")})
#' @rdname perm_score-methods
#' @aliases perm_score perm_score-methods
setMethod("perm_score",signature="NFP",
function(object){
object@randomized_score
}
)
#' Extract the cluster information of \emph{NFP}.
#'
#' This function extract the cluster information of network fingerprint.
#'
#'@exportMethod cluster_info
#'@rdname cluster_info-methods
#'@name cluster_info-methods
#'@param object \code{NFP} object
#'@aliases cluster_info cluster_info-methods
#'@docType methods
#'@seealso \code{\link{NFP}}
#'@return a list which contains the number, the examplar and some other cluster
#'properties.
setGeneric("cluster_info",
function(object){standardGeneric("cluster_info")})
#' @rdname cluster_info-methods
#' @aliases cluster_info cluster_info-methods
setMethod("cluster_info",signature="NFP",
function(object){
NFP_cluster <- object@cluster
return(NFP_cluster)
}
)
#' subset of NFP object
#'
#' This function extract the subsets of NFP-class.
#'
#'@exportMethod sub_NFP
#'@rdname sub_NFP-methods
#'@name sub_NFP-methods
#'@param object, \code{NFP} class
#'@param i, numeric or character indicating the index or the names of the
#'reference network
#'@aliases sub_NFP sub_NFP-methods
#'@docType methods
#'@seealso \code{\link{NFP-class}}
#'@return an similar NFP object contain just the selected elements.
setGeneric("sub_NFP",
function(object, i){standardGeneric("sub_NFP")})
#' @rdname sub_NFP-methods
#' @aliases sub_NFP sub_NFP-methods
setMethod("sub_NFP",signature="NFP",
function(object,i){
if(!(is.character(i) || is.numeric(i)))
stop('i must be character or numeric')
##ans <- c("raw_score", "randomized_score", "standardized_score", "cluster")
raw_score <- object@raw_score
randomized_score <- object@randomized_score
standardized_score <- object@standardized_score
cluster <- object@cluster
refnet_name <- randomized_score$net_names
names(raw_score) <- refnet_name
row.names(randomized_score) <- refnet_name
names(standardized_score) <- refnet_name
names(cluster) <- refnet_name
if(is.character(i))
i <- match(i,refnet_name, nomatch = 0)
sub_raw_score <-raw_score[i]
sub_randomized_score <- randomized_score[i,]
sub_standardized_score <- standardized_score[i]
sub_cluster <- cluster[i]
return(new('NFP',raw_score = sub_raw_score, randomized_score = sub_randomized_score,
standardized_score = sub_standardized_score, cluster = sub_cluster))
}
)
#' The show generic function
#'
#' Show a shor summary for NFP object, see \code{\link[methods]{show}}.
#'
#'@exportMethod show
#'@param object, \code{NFP} object
#'@docType methods
#'@rdname show-methods
#'@aliases show show-methods
setMethod("show", "NFP",
function(object){
para_name <- c("Number of ref networks", "Permutation number")
network_num <- object@raw_score %>% length
perm_num <- object@randomized_score %>% ncol %>% subtract(2)
cluster_num <- lapply(object@cluster, length) %>% unlist
cluster_num <- ifelse(length(cluster_num) > 5, cluster_num[1:5], cluster_num)
para_num <- c(length(object@raw_score), length)
group_num <- object@randomized_score %>% use_series('group') %>%
unique %>% length
cat(class(object),"object","\n")
cat("\n")
cat("Number of ref networks", "=", network_num, "\n")
cat('Group numbrer of networks', '=', group_num, '\n')
cat("Permutation number", "=", perm_num,"\n")
if(length(cluster_num) > 5)
cat("Number of clusters", '=', paste0(cluster_num,','),
"...omit several results","\n")
else
cat("Number of clusters", '=', cluster_num,"\n")
cat('\n')
cat('Standardized NFP\n')
print(object@standardized_score)
}
)
#' Plot NFP results
#'
#' Function for visualization NFP results.
#'
#'@exportMethod plot_NFP
#'@rdname plot_NFP-methods
#'@name plot_NFP-methods
#'@param object, \code{NFP} class
#'@param type, types of the visaulization of \emph{NFP} object, point or line.
#'Default is point.
#'@param p_size, point size of plot, default is 2.
#'@param l_size, line size of plot, default is 0.5.
#'#'@aliases plot_NFP plot_NFP-methods
#'@docType methods
#'@seealso \code{\link{NFP-class}}
setGeneric("plot_NFP",
function(object, type = c('matchstick', 'line','point'), p_size = 2, l_size = 0.5)
{standardGeneric("plot_NFP")})
#' @rdname plot_NFP-methods
#' @aliases plot_NFP plot_NFP-methods
setMethod("plot_NFP",'NFP',
function(object, type = c('matchstick', 'line','point'), p_size = 2, l_size = 0.5){
type <- match.arg(type, c('matchstick', 'line','point'))
if (class(object) == 'NFP'){
nfp_score <- object@standardized_score
nfp_refnet_group <- object@randomized_score %>%
use_series('group')
sim_df <- data.frame(NFP_sim = nfp_score, group = nfp_refnet_group,
refnet_index = 1:nrow(object@randomized_score))
network_num <- length(nfp_score)
if(all(!is.na(nfp_score))){ # skip plot if sim is NA
p <- ggplot(sim_df,aes(x = refnet_index, y = NFP_sim))
if(type == "point")
print(p + geom_point(size = p_size, aes(color = group)))
if(type == "line")
print(p + geom_line(size = l_size, aes(color = group, group = 1)))
if (type == 'matchstick')
print(p + geom_point(size = p_size, aes(color = group)) +
geom_segment(aes(xend = refnet_index, yend = 0, color = group),
size = l_size))
}
else
stop('NFP similarity score must be NA')
}
}
)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.