R/moy.R

In philippemichel/thesisph: Tout ce qu'il faut pour debuter un travail simple

#' Mean & standard deviation
#'
#' @param x : vecteur numerique
#'
#' @import stats
#'
#' @return mean +/- sd
#' @examples moys(iris$Sepal.Length)
#' @export
moys <- function(x){
  mm <- signif(mean(x,na.rm = TRUE),3)
  ss <- signif(sd(x,na.rm = TRUE),3)
  ligm <- paste0(mm," ± ",ss)
  return(ligm)
}


#' Ligne variable numerique - bootstrap
#' Ecrit la ligne du tableau pour une variable numerique
#'
#' @param nom : names of the studied variable
#' @param varp : studiet variable
#' @param trip : explicative variable
#' @param kk : TRUE pour sortie kable, FALSE pour xtable (default)
#'
#' @import stats
#' @import rlang
#'
#' @examples petal <- iris$Sepal.Length
#'           type <- iris$Species
#'           lignum("petale",petal,type, kk = TRUE)
#' @return a vector name, mean + sd for each level of trip ,p-value
#'
#' @export
<<<<<<< HEAD
lignum <- function(nom,varp,trip, kk) {
  dfp <- data.frame(varp,trip)
  tano <- anova(lm(varp ~ trip))
  pano <- beaup(tano$`Pr(>F)`[1])
=======
lignum <- function(nom, varp, trip, kk = TRUE) {
  dfp <- data.frame(varp, trip)
  tano <- anova(lm(varp ~ trip))
>>>>>>> 42b20b896837efe579944162827a68963584f331
  zz <- dfp %>%
    group_by(trip) %>%
    summarise(moys(varp), .groups = "drop")
  zz <- zz[2]
  if (kk == FALSE) {
    nom <- paste0("\\midrule ", nom)
  }
  else{
    nom <- nom
  }
  lig <- c(nom, zz[[1]], beaup(tano$`Pr(>F)`[1]))
  return(lig)
}


#' Tableau variable factorielle
#' Pour une variable factorielle, ecrit les lignes par niveau.
#'
#' @param nom : names of the studied variable
#' @param varp : studiet variable
#' @param trip : explicative variable
#' @param kk : TRUE pour sortie kable, FALSE pour xtable (default)
#'
#' @import stats
#' @import stringr
#'
#' @examples petal <- iris$Sepal.Length
#'           type <- iris$Species
#'           ligff("petale", petal, type, kk = TRUE)
#' @return a table, first line with name and p-value, and one line by levle of varp with n(%) for eache level of trip
#'
#' @export
ligff <- function(nom, varp, trip, kk) {
  tabp <- table(varp, trip)
<<<<<<< HEAD
  chip <- chisq.test(tabp, correct = T)[[3]]
  esp <- "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;"
=======
  chip <- chisq.test(tabp, correct = FALSE)
  if (min(chip$expected)<5){chip <- chisq.test(tabp, correct = TRUE)}
  chip <- chip[[3]]
>>>>>>> 42b20b896837efe579944162827a68963584f331
  if (is.na(chip)){
    chip <- fisher.test(tabp)[[1]]
  }
  chip <- beaup(chip)
<<<<<<< HEAD
=======
  esp <- ifelse(kk,"&nbsp;","~")
  esp <- stringr::str_c(rep(esp,6), collapse = "")
>>>>>>> 42b20b896837efe579944162827a68963584f331
  ltri <- length(levels(trip))
  lvar <- length(levels(varp))
  if (kk == 1){
    nomg <- nom
  }
  else{
    if (kk){nomg <- nom
    }else{
      nomg <- paste0("\\midrule\\textbf{",nom,"}")
    }
  }
  tabg <- c(nomg, rep(" ", ltri), chip)
  #
  ss <- colSums(tabp)
  for (lig in 1:lvar) {
    ligt <- paste0(esp,levels(varp)[lig])
    for (cas in 1:ltri) {
      casx <- tabp[lig, cas]
      casp <- round(100*casx/ss[cas],1)
      cast <- paste0(casx,"/",ss[cas]," (",casp," %)" )
      ligt <- c(ligt,cast)
    }
    ligt <- c(ligt, " ")
    tabg <- rbind(tabg, ligt)
  }
  return(tabg)
}