R/Compute_PBF.R

Defines functions compute_pbf_for_curve compute_pbf compute_pbf_at_x compute_exponential_sum compute_k element_wise_division x_substraction den_sub sum_num

Documented in compute_exponential_sum compute_k compute_pbf compute_pbf_at_x compute_pbf_for_curve den_sub element_wise_division sum_num x_substraction

#' 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)
  }
}
jfores/DocTDA documentation built on March 19, 2022, 9:37 p.m.