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))}
}