Traduções desta página:

Ferramentas do usuário

Ferramentas do site


05_curso_antigo:r2018:alunos:trabalho_final:karina.banci:prior

PRIOR

###Cria a função prior e seus argumentos
prior = function(x,saveprior=TRUE){
    ###verificar se há NA's no dataframe
    if(sum(is.na(iprior))){
        ###mensagem de alerta, sem interromper função
        warning("espécies com NA desconsideradas")
        ###remover linhas com NA
        iprior <- na.omit(iprior)
    }
    
    ###fazer com que todos os nomes das colenas estejam em minúsculo
    colnames(iprior) <- tolower(colnames((iprior)))
    
    ###verificar se há espécies cujo status na IUCN seja NE
    if("NE" %in% iprior$iucn){
        ###mensagem de alerta, sem interromper função
        warning("espécies com NE desconsideradas")
        ###remover linhas com NE
        iprior <- subset(iprior, iprior$iucn!="NE")
    }
    
    ###verificar se há espécies cujo status na IUCN seja NE
    if("DD" %in% iprior$iucn){
        ###mensagem de alerta, sem interromper função
        warning("espécies com DD desconsideradas")
        ###remover linhas com DD
        iprior <- subset(iprior, iprior$iucn!="DD")
    }
    
    
    ###RESIGNIFICAÇÃO DAS SIGLAS DAS VARIÁVEIS CATEGÓRICAS####
    
    ###Variável acasalamento
    ###Cálculo da frequência de espécies monogâmicas
    freq.M <- (nrow(iprior[iprior$acasalamento=="M",]))/nrow(iprior)
    ###Cálculo da frequência de espécies poligâmicas
    freq.P <- (nrow(iprior[iprior$acasalamento=="P",]))/nrow(iprior)
    ###Se a frequência de monogâmicas for maior do que a de poligâmicos
    if(freq.M>freq.P){
        ###atribuir valor 2 para espécies monogâmicas
        M.maior <- gsub("M",2,iprior$acasalamento)
        ###atribuir valor 1 para espécies poligâmicas
        iprior$acasalamento <- as.numeric(gsub("P",1,M.maior))
        ###Se a frequência de monogâmicas for menor do que a de poligâmicos
    }else{
        ###atribuir valor 1 para espécies monogâmicas
        M.menor <- gsub("M",1,iprior$acasalamento)
        ###atribuir valor 1 para espécies monogâmicas
        iprior$acasalamento <- as.numeric(gsub("P",2,M.menor))
    }
    
    ###Variável Dieta
    ###Cálculo da frequência de espécies com dietas especialistas
    freq.E <- (nrow(iprior[iprior$dieta=="E",]))/nrow(iprior)
    ###Cálculo da frequência de espécies com dietas generalistas
    freq.G <- (nrow(iprior[iprior$dieta=="G",]))/nrow(iprior)
    ###Se a frequência de especialistas for maior do que a de generalistas
    if(freq.E>freq.G){
        ###atribuir valor 2 para espécies especialistas
        E.maior <- gsub("E",2,iprior$dieta)
        ###atribuir valor 1 para espécies generalistas
        iprior$dieta <- as.numeric(gsub("G",1,E.maior))
        ###Se a frequência de especialistas for menor do que a de generalistas
    }else{
        ###atribuir valor 1 para espécies especialistas
        E.menor <- gsub("E",1,iprior$dieta)
        ###atribuir valor 2 para espécies generalistas
        iprior$dieta <- as.numeric(gsub("G",2,E.menor))
    }
    
    ###Variável Habitat
    ###Cálculo da frequência das espécies de área aberta
    freq.A <- (nrow(iprior[iprior$habitat=="A",]))/nrow(iprior)
    ###Cálculo da frequência das espécies de área fechada
    freq.F <- (nrow(iprior[iprior$habitat=="F",]))/nrow(iprior)
    ###Se a frequência de espécies de áreas abertas for maior do que a de áreas fechadas
    if(freq.A>freq.F){
        ###atribuir valor 2 para espécies de área aberta
        A.maior <- gsub("A",2,iprior$habitat)
        ###atribuir valor 1 para espécies de área fechada
        iprior$habitat <- as.numeric(gsub("F",1,E.maior))
        ###Se a frequência de espécies de áreas abertas for menor do que a de áreas fechadas
    }else{
        ###atribuir valor 1 para espécies de área aberta
        A.menor <- gsub("A",1,iprior$habitat)
        ###atribuir valor 2 para espécies de área fechada
        iprior$habitat <- as.numeric(gsub("F",2,A.menor))
    }
    
    ###Variável Atividade
    ###Cálculo da frequência de espécies diurnas
    freq.D <- (nrow(iprior[iprior$atividade=="D",]))/nrow(iprior)
    ###Cálculo da frequência de espécies noturnas
    freq.N <- (nrow(iprior[iprior$atividade=="N",]))/nrow(iprior)
    ###Se a frequência de espécies diurnas for maior do que a de noturnas
    if(freq.D>freq.N){
        ###atribuir valor 2 para espécies diurnas
        D.maior <- gsub("D",2,iprior$atividade)
        ###atribuir valor 1 para espécies noturnas
        iprior$atividade <- as.numeric(gsub("N",1,D.maior))
        ###Se a frequência de espécies diurnas for menor do que a de noturnas
    }else{
        ###atribuir valor 1 para espécies diurnas
        D.menor <- gsub("N",1,iprior$atividade)
        ###atribuir valor 2 para espécies noturnas
        iprior$atividade <- as.numeric(gsub("N",2,D.menor))
    }
    
    ###Variável Sociabilidade
    ###Cálculo da frequência de espécies solitárias
    freq.Sl <- (nrow(iprior[iprior$sociabilidade=="Sl",]))/nrow(iprior)
    ###Cálculo da frequência de espécies sociais
    freq.So <- (nrow(iprior[iprior$sociabilidade=="So",]))/nrow(iprior)
    ###Se a frequência de espécies solitárias for maior do que a de sociais
    if(freq.Sl>freq.So){
        ###atribuir valor 2 para espécies solitárias
        Sl.maior <- gsub("Sl",2,iprior$sociabilidade)
        ###atribuir valor 1 para espécies sociais
        iprior$sociabilidade <- as.numeric(gsub("So",1,Sl.maior))
        ###Se a frequência de espécies solitárias for menor do que a de sociais
    }else{
        ###atribuir valor 1 para espécies solitárias
        Sl.menor <- gsub("Sl",1,iprior$sociabilidade)
        ###atribuir valor 2 para espécies sociais
        iprior$sociabilidade <- as.numeric(gsub("So",2,Sl.menor))
    }
    
    
    ###RESIGNIFICAÇÃO DAS CATEGORIAS DA IUCN
    ###atribuir valor 5 para espécies com status LC na IUNC
    iucn.lc <- gsub("LC",5,iprior$iucn)
    ###atribuir valor 4 para espécies com status NT na IUNC
    iucn.nt <- gsub("NT",4,iucn.lc)
    ###atribuir valor 3 para espécies com status VU na IUNC
    iucn.vu <- gsub("VU",3,iucn.nt)
    ###atribuir valor 2 para espécies com status EN na IUNC
    iucn.en <- gsub("EN",2,iucn.vu)
    ###atribuir valor 1 para espécies com status CR na IUNC
    iprior$iucn <- as.numeric(gsub("CR",1,iucn.en))
    
    
    ###CÁLCULO DAS DIFERENÇAS DOS VALORES DAS VARIÁVEIS PARA SUAS MÉDIAS
    ###diferenças entre cada tamanho e a média dos tamanhos
    iprior$tamanho <- iprior$tamanho-mean(iprior$tamanho)
    ###Rankeamento destas médias, da maior para a menor
    iprior$tamanho <- rank(-iprior$tamanho)
    
    ###diferenças entre cada longevidade e a média das longevidades
    iprior$longevidade <- iprior$longevidade-mean(iprior$longevidade)
    ###Rankeamento destas médias, da maior para a menor
    iprior$longevidade <- rank(-iprior$longevidade)
    
    ###diferenças entre cada distribuicao e a média das distribuicoes
    iprior$distribuicao <- iprior$distribuicao-mean(iprior$distribuicao)
    ###Rankeamento destas médias, da menor para a maior
    iprior$distribuicao <- rank(iprior$distribuicao)
    
    ###diferenças entre cada latitude e a média das latitudes
    iprior$latitude <- iprior$latitude-mean(iprior$latitude)
    ###Rankeamento destas médias, da maior para a menor
    iprior$latitude <- rank(iprior$latitude)
    
    ###diferenças entre cada densidade e a média das densidades
    iprior$densidade <- iprior$densidade-mean(iprior$densidade)
    ###Rankeamento destas médias, da menor para a maior
    iprior$densidade <- rank(iprior$densidade)
    
    ###diferenças entre cada área de vida e a média das áreas de vida
    iprior$area.de.vida <- iprior$area.de.vida-mean(iprior$area.de.vida)
    ###Rankeamento destas médias, da maior para a menor
    iprior$area.de.vida <- rank(-iprior$area.de.vida)
    
    ###diferenças entre cada gestação e a média das gestações
    iprior$gestacao <- iprior$gestacao-mean(iprior$gestacao)
    ###Rankeamento destas médias, da maior para a menor
    iprior$gestacao <- rank(-iprior$gestacao)
    
    ###diferenças entre cada tamanho de prole a média dos tamanhos de prole
    iprior$prole <- iprior$prole-mean(iprior$prole)
    ###Rankeamento destas médias, da menor para a maior
    iprior$prole <- rank(iprior$prole)
    
    
    ###criação do objeto Ecological Oddity (eo) contendo a média dos rankings das variáveis tamanho, longevidade, distribuição, latitude, densidade, área de vida, gestação, prole, sistema de acasalamento, dieta, hábitat, atividade e sociabilidade por espécie
    ###Soma dos rankings de todas as variáveis, exceto IUCN, por espécie
    sum.eo <- apply(iprior[,-ncol(iprior)],1,sum)
    ###Cálculo do Ecological Oddity (eo), que é a média dos rankings por espécie
    eo <- sum.eo/(ncol(iprior)-1)
    ###Tranformação de EO em dataframe
    eo <- data.frame(eo)
    ###Rankeamento das espécies com base nos valores de EO
    eo <- rank(eo)
    ###Une a coluna EO ao dataframe iprior
    iprior <- cbind(iprior,eo)
    ###Reordena as colunas, colocando EO antes do status da IUCN
    iprior <- iprior[,c(1:(ncol(iprior)-2), ncol(iprior), (ncol(iprior)-1))]
    
    
    ###CÁLCULO DO ÍNDICE DE PRIORIZAÇÃO, A PARTIR DA MÉDIA ENTRE EO E O STATUS DA IUCN
    index <- iprior$eo+iprior$iucn/2
    ###Transforma o índice em dataframe
    index <- data.frame(index)
    ### Faz o rankeamento das espécies de acordo com o índice de priorização
    index <- rank(index)
    ###Une a coluna do índice de priorização ao dataframe iprior
    iprior <- cbind(iprior,index)
    ###Altera o nome do dataframe final para prior
    prior <- iprior
    
    if(saveprior != TRUE){
        ###armazena o arquivo prior no Work Space
        return(prior)
    }else{
        ###Salva o dataframe prior contendo os resultados em formato csv
        write.table(iprior, "prior.csv",sep=";",col.names=NA)    
        ###armazena o arquivo prior no Work Space
        return(prior)
            }
}
05_curso_antigo/r2018/alunos/trabalho_final/karina.banci/prior.txt · Última modificação: 2020/08/12 06:04 (edição externa)