#' sum_num
#'
#'Computes the fraction of the numeratior of the exponentiated function in the PBF
#'
#' @param barcode_dim The barcode matrix for a particular dimension.
#'
#' @return Returns the fraction in the numerator of the PDF.
#' @export
#'
#' @examples
#' \dontrun{
#' sum_num(barcode_dim)
#' }
sum_num <- function(barcode_dim){
frac_num <- (barcode_dim$death + barcode_dim$birth)/2
return(frac_num)
}
#' den_sub
#'
#' Computes the substraction presennnn the exponentiated function of the PBF.
#'
#' @param barcode_dim The barcode matrix for a particular dimension.
#'
#' @return
#' @export
#'
#' @examples
#' \dontrun{
#' den_sub(barcode_dim)
#' }
den_sub <- function(barcode_dim){
frac_den <- barcode_dim$death - barcode_dim$birth
return(frac_den)
}
#' x_sustraction
#'
#' @param x the value of x
#' @param frac_num the fraction numerator.
#'
#' @return Substraction value.
#' @export
#'
#' @examples
#' \dontrun{
#' den_sub(barcode_dim)
#' }
x_substraction <- function(x,frac_num){
return(x - frac_num)
}
#' element_wise_division
#'
#' Divides two vectors on an element-by-element basis.
#'
#' @param x a numeric vector x
#' @param y a numeric vertor y
#'
#' @return Returns a vector with the computed element-wise division.
#' @export
#'
#' @examples
#' \dontrun{
#' element_wise_division(x,y)
#' }
element_wise_division <- function(x,y){
return(x/y)
}
#' compute_k
#'
#' This function exponentiates to k the quotient of the exponential.
#'
#' @param quotient_ind Value of the quotient in the exponentianted part of the function.
#' @param k Exponenet.
#'
#' @return Returns the exponentiated quotient.
#' @export
#'
#' @examples
#' \dontrun{
#' compute_k(quotient_ind,k)
#' }
compute_k <- function(quotient_ind,k){
return(quotient_ind^k)
}
#' compute_exponential_sum
#'
#' Function that computes the summation of the exponential.
#'
#' @param quotient_dim values of exponentiation function.
#'
#' @return returns the summation of the exponential.
#' @export
#'
#' @examples
#' \dontrun{
#' compute_exponential_sum(quotient_dim,k)
#' }
compute_exponential_sum <- function(quotient_dim){
exponential <- sum(exp(-quotient_dim))
return(exponential)
}
#' compute_pbf_at_x
#'
#' @param x x value
#' @param barcode a particular barcode.
#' @param k The value of exponent k
#'
#' @return Returns the pbf function at point x
#' @export
#'
#' @examples
#' \dontrun{
#' compute_pbf_at_x(x,barcode,k)
#' }
compute_pbf_at_x <- function(x,barcode,k = 2){
barcode <- data.frame(barcode)
splitted_barcode <- base::split(barcode,as.factor(barcode$dimension))
frac_num_list <- base::lapply(splitted_barcode,sum_num)
x_frac_num_list <- base::lapply(frac_num_list,x_substraction,x = x)
frac_den_list <- base::lapply(splitted_barcode,den_sub)
element_wise_quotient <- base::mapply(element_wise_division,x_frac_num_list,frac_den_list)
element_wise_quotient_k <- base::lapply(element_wise_quotient, compute_k,k = k)
element_wise_exponential <- base::lapply(element_wise_quotient_k,compute_exponential_sum)
return(element_wise_exponential)
}
#' compute_pbf
#'
#' @param vec_vals values of x for which the pbf function must be computed
#' @param barcode matrix with the barcode information generated by compute_homology or compute_homology_multi functions.
#' @param k Parameter k for exponentiation.
#'
#' @return Returns a list with the PBF for each tested dimension.
#' @export
#'
#' @examples
#' \dontrun{
#' compute_pbf(vec_vals,barcode,2)
#' }
compute_pbf <- function(vec_vals,barcode,k=2){
results_all <- lapply(vec_vals,compute_pbf_at_x,barcode = barcode)
dim_zero <- unlist(lapply(results_all, function(x) x[[1]]))
dim_one <- unlist(lapply(results_all, function(x) x[[2]]))
dim_two <- unlist(lapply(results_all, function(x) x[[3]]))
list_out <- list(dim_zero,dim_one,dim_two)
}
#' compute_pbf_for_curve
#'
#' @param vec_vals vector with the x values to compute the PBF function.
#' @param barcode matrix with the barcode information generated by compute_homology or compute_homology_multi functions.
#' @param k Parameter k for exponentiation.
#' @param dim_betti Betti dimension to test.
#'
#' @return Returns PBF for a specified Betti dimension.
#' @export
#'
#' @examples
#' \dontrun{
#' compute_pbf_for_curve(vec_vals,barcode,2,0)
#' }
compute_pbf_for_curve <- function(vec_vals,barcode,k=2,dim_betti = c(0,1,2)){
results_all <- lapply(vec_vals,compute_pbf_at_x,barcode = barcode)
dim_zero <- unlist(lapply(results_all, function(x) x[[1]]))
dim_one <- unlist(lapply(results_all, function(x) x[[2]]))
dim_two <- unlist(lapply(results_all, function(x) x[[3]]))
if(dim_betti == 0){
return(dim_zero)
}
if(dim_betti == 1){
return(dim_one)
}
if(dim_betti == 2){
return(dim_two)
}
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.