R/finemeshed2d.R

Defines functions finemeshed2d

Documented in finemeshed2d

#' finemeshed2d
#'
#' Function that helps to transform  a vector into a matrix (with a fine mesh). In the implementation of the spiceFP approach,
#' it allows to transform matrices of coefficients having different dimensions into matrices of the
#' same dimension in order to perform arithmetic operations. In practice, the matrix to be transformed is
#' associated with a contingency table, which implies numerical variables for which classes have been created.
#'
#'
#' @param x vector or one column matrix to scale. This vector comes from the vectorization of the
#' matrices to be transformed. x is named using the concatenation of the names of the rows and
#' the names of the columns of the matrix to be transformed, as shown in the example below.
#' @param n.breaks1 integer. Number of breaks needed for the first variable.
#' The variable for which classes are in first position when constructing x's names is the first variable.
#' @param n.breaks2 integer. Number of breaks needed for the second variable. The variable for which classes are
#' in second position when constructing x's names is the second variable.
#' @param round.breaks1 integer. Number of decimals for breaks of the first variable.
#' @param round.breaks2 integer. Number of decimals for breaks of the second variable.
#'
#' @details This function is designed to return a fine meshed matrix and breaks associated.
#' In order to obtain a fine mesh, a high number of breaks must be fixed.
#'
#' @return Returns:
#' \describe{
#' \item{finemeshed.matrix}{Matrix of dimension n.breaks2 x n.breaks1. The row and column names of finemeshed.matrix are the
#' breaks created from each variable and the associated n.breaks. Each value of finemeshed.matrix is equal to the value of
#' x indexed by the classes containing the row and column names of finemeshed.matrix}
#' \item{finemeshed.values1}{First variable breaks}
#' \item{finemeshed.values2}{Second variable breaks}
#' }
#'
#'
#' @importFrom stringr str_split
#'
#' @examples
#' set.seed(45)
#' count_table<- hist_2d(x = rnorm(1000),
#'                       y = rnorm( 1000,5,0.1),
#'                       breaks_x = seq(-4, 4, by =1),
#'                       breaks_y = seq(2, 8, by =1))$Hist.Values
#'
#' df.x<-as.data.frame.table(count_table)
#' x<-df.x$Freq
#' names(x)<-paste0(df.x$Var1,"_",df.x$Var2)
#'
#' res.fm2d <- finemeshed2d(x,100,100)
#' dim(res.fm2d$finemeshed.matrix)
#' @export



finemeshed2d <- function(x,
                         n.breaks1=1000,
                         n.breaks2=1000,
                         round.breaks1=9,
                         round.breaks2=9){
  retain_c_name <- if(is.matrix(x)) {rownames(x)} else {names(x)}

  # Find the 4 boundaries of each break 2d via the name of the breaks
  # (name having a certain format)
  var1_min <- as.numeric(chartr(old = "[",
                                new = " ",
                                str_split(str_split(retain_c_name,"_",simplify = TRUE)[,1] ,
                                                    "," , simplify = TRUE)[,1]))
  var1_max <- as.numeric(chartr(old = "[",
                                new = " ",
                                str_split(str_split(retain_c_name,"_",simplify = TRUE)[,1] ,
                                                    "," , simplify = TRUE)[,2]))
  var2_min <- as.numeric(chartr(old = "[",
                                new = " ",
                                str_split(str_split(retain_c_name,"_",simplify = TRUE)[,2] ,
                                                    "," , simplify = TRUE)[,1]))
  var2_max <- as.numeric(chartr(old = "[",
                                new = " ",
                                str_split(str_split(retain_c_name,"_",simplify = TRUE)[,2] ,
                                                    "," , simplify = TRUE)[,2]))

  ## limits
  var1min_smr = min(var1_min) ; var1max_smr = max(var1_max)
  var2min_smr = min(var2_min) ; var2max_smr = max(var2_max)

  ## Values var2 and var1
  valeurs_var1_smr = unique(round(seq(var1min_smr,
                                      var1max_smr,
                                      length.out = n.breaks1),
                                  round.breaks1))
  valeurs_var2_smr = unique(round(seq(var2min_smr,
                                      var2max_smr,
                                      length.out = n.breaks2 ),
                                  round.breaks2))

  smr_0 = matrix(NA,
                 nrow = length(valeurs_var1_smr) ,
                 ncol = length(valeurs_var2_smr) ,
                 dimnames = list(valeurs_var1_smr, valeurs_var2_smr))

  for(i in 1:length(x)){
    smr_0[which(as.numeric(rownames(smr_0)) >=  var1_min[i] &
                as.numeric(rownames(smr_0)) <= var1_max[i]) ,
           which(as.numeric(colnames(smr_0)) >= var2_min[i] &
                 as.numeric(colnames(smr_0)) <= var2_max[i])] <- x[i]
  }

  return(list(finemeshed.matrix=smr_0,
              finemeshed.values1=valeurs_var1_smr,
              finemeshed.values2=valeurs_var2_smr)
         )
}

Try the SpiceFP package in your browser

Any scripts or data that you put into this service are public.

SpiceFP documentation built on June 7, 2023, 5:55 p.m.