HELP_DA_FUNÇÃO

 
Função : Debaixo dos caracóis dos seus cabelos
Por: Anne Elise Landine

cachos <- function(comprI, comprF, tipos = length(comprI), força = 0.2)
{
  if(!require(install.load)) install.packages('install.load'); library(install.load)
  install.load::install_load('dplyr') ##instalando pacotes necessários
  if(class(comprI) != 'numeric' | class(comprF) != "numeric")
  {stop("O vetor de comprimento inicial e de comprimento final devem ser da classe numeric.")}
  if (length(comprI) != length(comprF)) ## parar se os comprimentos iniciais não tiverem seus correspondentes nos valores de comprimento final.
  {stop("nem todos os comprimentos iniciais possuem comprimentos finais, após a aplicação de força.")}
  if (length(comprI) != tipos) #não é algo que faça diferença no cálculo em si, mas é mais uma etapa de interação, para que a pessoa veja com cautela os tipos diferentes de cabelo que mediu.
  {stop("meça todos os diferentes tipos de curvaturas de cachos. Caso você estime que tenha 3 diferentes tipos de cachos, por exemplo (ex. 3A, 4B, 2C), meça o comprimento inicial de todos.")}
  if (is.null(força)) 
  {stop("forneça o valor do peso usado para alongar o cabelo, em Kg")} #é preciso fornecer o peso que foi utilizado para "esticar" o cabelo, para calcular o coeficiente de deformação elástica
  class(tipos) <- 'integer'
  data <- data.frame(comprI, comprF, rep(força, length(comprI))) #criando um dataframe com os valores inseridos nos argumentos da função
  colnames(data) <- c("comprI", "comprF", "peso") #mudando o nome das colunas
  data$peso <- data$peso *10 #convertendo Kg para N.
  data$alongamento <- (data$comprF - data$comprI) #calculando o delta de deformação
  data$K <- data$peso/data$alongamento #constante elástica.###quanto menor o K mais enrolado
  data[order(data$K),] ##menores valores: cabelo menos curvado.
  ###Cálculo da deformação elástica para diferentes forças aplicadas, visto que já temos a contante elástica ##classificar entre 2 e 4
  data1 <- data.frame(rep(data$comprI, each = 5), 
                      rep(data$K, each = 5)) #criando um dataframe com os valores inseridos nos argumentos da função repetidos 5x, para cálcular a deformação do cabelo com 5 valores de força diferentes
  colnames(data1) <- c( "comprI", "K") #mudando o nome das colunas
  data1[order(data1$K),] #ordenando os valores em função da constante elástica
  data1$id <- rep(1:length(data$K), each = 5, len = length(data1$K)) #criando uma coluna id, para saber qual identificação do cabelo. Quais valores correspondem ao montante de cabelo medido e fornecido na primeira colocação dos argumentos comprI e comprF, e assim por diante.
  len1 <- length(data$K) #tamanho da coluna com os valores da constante elástica
  len2 <- length(data1$K)#tamanho da coluna com os valores da constante elástica
  data1$força <- rep(seq(3,5, len = len1), length.out = len2) #criando valores de força para calcular o delta de deformação para diferentes aplicações de peso no cabelo
  data1$alongamento <- data1$força/data1$K #calculando o delta de deformação para diferentes aplicações de força
  data1<-data1%>%
    group_by(id) %>% 
    mutate(Threshold = mean(alongamento)) ##media de alongamento de cada id
  data1$indice <- data1$Threshold/data1$comprI ##calculo para saber quantas vezes mais o cabelo sofre deformação ao aplicar-se uma força x, em relação ao seu comprimento inicial
  a <- split(data1, data1$id) #separando os dataframes por id
  data1 <- as.data.frame(data1) #retornando a classe dataframe
  data$id <- rep(1:length(a)) #criando uma coluna com os ids (identificação)
  data[order(data$K),] #ordenando os valores em função da constante elástica
  
  #Liso #cálculos para um cabelo sem ondução
  if(sum(data1$indice < 0.05)>0) ##valores de deformação mais baixos.
  {liso <- data1[data1$indice < 0.1,]
  liso$tipo <- "1" #tipo de cabelo 1: liso
  data2 <- liso} ##separando a categoria "liso"
  if(sum(data1$indice < 0.05) == 0) ##caso não tenham valores onde o índice seja menor do que 0.05
  {
    data2 <- NA 
  }
  #Ondulado #cabelo ondulado varia o seu tamanho entre 0.05x e 0.5x
  if(sum(data1$indice >= 0.05 & data1$indice <= 0.5) > 0) #os cálculos da variação dos tipos de cabelo(A,B,C) foram feitos a priori, baseado em dados reais de cabelos com diferentes curvaturas
  {
    ondulado <- data1[data1$indice >= 0.05 & data1$indice <= 0.5,]
    dif <- 0.5 - 0.05 #calculando o intervalo de diferença entre os valores correspondentes a curvatura ondulada
    ond <- dif/3 #dividindo o intervalo de curvatura ondulado em três partes (A,B,C)
        if(sum(ondulado$indice >= 0.1 & ondulado$indice <= ond) > 0) #se o cabelo ondulado varia entre 0.1 e valor da diferença do intervalo/3 -> 2A
        { 
          onA <- ondulado[ondulado$indice >= 0.1 & ondulado$indice <= ond,]
          onA$tipo<- paste0("2A")
          #ondulado2 <- onA
          data2 <- rbind(data2,onA) ##calculo para separar o cabelo na categoria  "ondulado (2             ), A"
        }
          if(sum(ondulado$indice > ond & ondulado$indice <= (ond*2)) > 0) #se o cabelo ondulado varia entre a diferença entre os intervalos/3 e duas vezes o valor da diferença -> 2B
          {
            onB <- ondulado[ondulado$indice > ond & ondulado$indice <= (ond*2),]
            onB$tipo <- paste0("2B")
            #ondulado2 <- rbind(onA, onB)
            data2 <- rbind(data2,onB)
            }##calculo para separar o cabelo na categoria  "ondulado (2), B"
      
            if(sum(ondulado$indice > (ond*2) & ondulado$indice <= (ond*3)) > 0) #se o cabelo ondulado varia entre 2x o valor da diferença dos intervalos e 3x o valor da diferença dos intervalos -> 2C
              {
                onC <- ondulado[ondulado$indice > (ond*2) & ondulado$indice <= (ond*3),]
                onC$tipo <- paste0("2C")
                #ondulado2 <- rbind(ondulado2, onC)
                data2 <- rbind(data2,onC)
                }##calculo para separar o cabelo na categoria  "ondulado (2), C"
  }
  
  #Cacheado
  if(sum(data1$indice > 0.5 & data1$indice <= 3) > 0) #cabelos cacheados variam entre 0.5x e 3x seu tamanho.
  # a mesma lógica explicada para os cabelos ondulados foi aplicada para calcular os valores relativos aos cabelos cacheados (3) e crespos (4)
  {
    cacheado <- data1[data1$indice > 0.5 & data1$indice <= 3,]
    dif2 <- 3-0.5
    cach <- dif2/3  #dividindo o intervalo de curvatura ondulado em três partes (A,B,C)
    ##dividindo o intervalo de curvatura cacheado em três partes (A,B,C)
    if(sum(cacheado$indice >= 0.5 & cacheado$indice <= cach) > 0 )
    {
      caA <- cacheado[cacheado$indice >= 0.5 & cacheado$indice <= cach,] 
    caA$tipo<- paste0("3A")
    data2 <- rbind(data2, caA)} ##calculo para separar o cabelo na categoria  "cacheado (3), A"
    if(sum(cacheado$indice > cach & cacheado$indice <= (cach*2)) > 0)
    {
      caB <- cacheado[cacheado$indice > cach & cacheado$indice <= (cach*2),]
      caB$tipo <- paste0("3B")
      #cacheado2<- rbind(cacheado2, caB)
      data2 <- rbind(data2, caB)##calculo para separar o cabelo na categoria  "cacheado (3), B"
    }
      if(sum(cacheado$indice > (cach*2) & cacheado$indice <= (cach*3)) > 0)
      {
                caC <- cacheado[cacheado$indice > (cach*2) & cacheado$indice <= (cach*3),]
        caC$tipo <- paste0("3C")
        #cacheado2 <- rbind(cacheado2,caC)
        data2 <- rbind(data2, caC)} ##calculo para separar o cabelo na categoria  "cacheado (3), c"
    }   
     
  #Crespo #os cabelos crespos aumentam 3x ou mais do que o comprimento inicial, quando aplicada uma força x que o deforme.
  if(sum(data1$indice > 3) > 0)
  {
    crespo <- data1[data1$indice > 3,]
    cres <- 1.5/3 #dividindo o intervalo de curvatura crespo em três partes (A,B,C)
  
  if(sum(crespo$indice >= 0.5 & crespo$indice <= cres) > 0)
  {
    crA <- crespo[crespo$indice >= 0.5 & crespo$indice <= cres,] 
    crA$tipo<- paste0("3A")
    #crespo2 <- crA
    data2 <- rbind(data2, crA)
  }##calculo para separar o cabelo na categoria  "crespo (4), A"
    if(sum(crespo$indice > cach & crespo$indice <= (cres*2)) > 0)
    {
      crB <- crespo[crespo$indice > cach & crespo$indice <= (cres*2),]
      crB$tipo <- paste0("3B")
      #crespo2 <- rbind(crespo2, crB)
      data2 <- rbind(data2, crB)}
    ##calculo para separar o cabelo na categoria  "crespo (4), B"
      if(sum(crespo$indice > (cres*2) & crespo$indice <= (cres*3)) > 0)
      {
        crC <- crespo[crespo$indice > (cres*2) & crespo$indice <= (cres*3),]
        crC$tipo <- paste0("3C")
        #crespo <- rbind(crespo2,crC)
        data2 <- rbind(data2, crC)}
      }##calculo para separar o cabelo na categoria  "crespo (4), C"
  
  spl <- split(data2, data2$id) #separando por id, o dataframe onde foi calculado as variações de ondulação do cabelo
  len4 <- length(spl) #tamanho da lista = ao tamanho de ids
  cada <- unique(data2$tipo)
  
if(sum(len4 == tipos) > 0)
    {
  return(list(cat("VocÊ sabe tudo sobre seu cabelo! Acertou a quantidade de diferentes tipos de curvatura seu cabelo apresenta.","tipos de cabelo:", cada, sep="\t"),data2))
    }
  if(len4>tipos)
  {return(list(cat("VocÊ mais tipos diferentes de cabelo do que imagina!", "tipos de cabelo:", cada, sep="\t"), data2))}
  if(len4 < tipos)
  {return(list(cat("Seu cabelo apresenta menos tipos do que o que você inseriu na função.", "tipos de cabelo:", cada, sep="\t"),data2))}

}