Traduções desta página:

Ferramentas do usuário

Ferramentas do site


05_curso_antigo:r2016:alunos:trabalho_final:karina.tisovec:cod_b_ka

Código B

 

#########################
# Pensa o que eu penso? #
#########################


##### Código da função #####

twit= function(dist=list(...), con=list(...), coord=TRUE, main=c(NULL), label=c("Indivíduo"), slabel=c("Distância"), lcol=c("white"), hcol= c("red"), tcol=c("black"), ncols=1) # criando o nome da função, os argumentos e seus respectivos defaults
{
  if ((length(grep("ggplot2", library()))==0)=="TRUE") # teste lógico que procura nos pacotes instalados o pacote "ggplot2" que será necessário para rodar a função
  {
    stop("Para essa função é necessário instalar o pacote 'ggplot2' (use a função install.packages()). É aconselhável antes de tentar rodar a função novamente, reiniciar o programa do R.") # caso o pacote não seja encontrado uma mensagem de aviso é lançada no console
  }
  
  if ((length(grep("reshape2", library()))==0)=="TRUE") # teste lógico que procura nos pacotes instalados o pacote "reshape2" que será necessário para rodar a função
  {
    stop("Para essa função é necessário instalar o pacote 'reshape2' (use a função install.packages()). É aconselhável antes de tentar rodar a função novamente, reiniciar o programa do R.") # caso o pacote não seja encontrado uma mensagem de aviso é lançada no console
  }
  
  library(ggplot2)
  library(reshape2)
  
  if (class(dist) != "list" || class(con) != "list") # teste lógico para ver se os objetos 'dist' e 'con' são listas
  {
    stop("Os objetos dos argumentos 'dist' e 'con' devem ser listas") # mensagem mostrada caso o teste dê verdadeiro
  }
  
  if (length(dist) != length(con)) # teste lógico para verificar se 'dist' e 'con' tem o mesmo tamanho
  {
    stop("O número de matrizes e/ou dataframes de 'dist' não é igual ao número de vetores de 'con'") # mensagem mostrada caso o teste dê verdadeiro
  }
  
  ############################################################################
  
  
  
  # a função multiplot já existe, para referência ver: 
  #http://www.cookbook-r.com/Graphs/Multiple_graphs_on_one_page_%28ggplot2%29/
  #http://www.peterhaschke.com/r/2013/04/24/MultiPlot.html
  
  multiplot= function(..., plotlist=NULL, file, cols=ncols, layout=NULL) 
  {
    library(grid)
    
    plots <- c(list(...), plotlist)
    
    numPlots = length(plots)
    
    if (is.null(layout)) 
    {
      layout <- matrix(seq(1, cols * ceiling(numPlots/cols)), 
                       ncol = cols, nrow = ceiling(numPlots/cols))
    }
    
    if (numPlots==1) 
    {
      print(plots[[1]])
    } 
    
    else 
    {
      grid.newpage()
      pushViewport(viewport(layout = grid.layout(nrow(layout), ncol(layout))))
      
      for (i in 1:numPlots) 
      {
        matchidx <- as.data.frame(which(layout == i, arr.ind = TRUE))
        
        print(plots[[i]], vp = viewport(layout.pos.row = matchidx$row,
                                        layout.pos.col = matchidx$col))
      }
    }
  }
  
  ########################################################################
  
  ciclos = length(dist) # cria um objeto com o número de ciclos (i.e plots gerados a partir das listas fornecidas)
  
  
  ########################################################################
  
  # as próximas linhas definem alguns argumentos para os plots dos heatmaps, como por exemplo, os nomes dos eixos, cores, etc... , caso não seja fornecida uma lista para os respectivos argumentos, ou seja fornecido apenas um caracter.
  
  argumentos= list(main, label, slabel, lcol, hcol, tcol) # cria uma lista com os argumentos que definem alguns parâmetros gráficos dos plots dos heat maps
  
  for(j in 1:6) # ciclo que verifica o comprimento de cada argumento da lista 'argumentos'
  {
    if (length(argumentos[[j]]) == 1) # teste lógico para verificar se o tamanho do argumento na posição [[j]] é igual a 1, se for:
    {
      argumentos[[j]]= rep(argumentos[[j]], ciclos) # sobrescreve o argumento da posição [[j]] da lista com uma repetição (número = ciclos) do caracter original daquele argumento
    }
  }
  
  # sobrescreve os argumentos com as repetições estipuladas acima
  main= argumentos[[1]] # para o argumento 'main'
  label= argumentos[[2]] #para o argumento 'label'
  slabel= argumentos[[3]] # ...
  lcol= argumentos[[4]]
  hcol= argumentos[[5]]
  tcol= argumentos[[6]]
  
  all.plots= list() # cria um uma lista onde serão guardados os plots (heat maps) de cada ciclo do for[k]
  
  for (k in 1:ciclos) # inicia o ciclo para plotar os diferentes heat maps que medem as distâncias entre os indivíduos e os conceitos avaliados 
    
    local( # cada ciclo será realizado num ambiente novo, de forma que as informações dos plots não se sobreescrevam 
      {
        
        k=k # cria um objeto com o valor do ciclo em questão
        
        individuos = length(con[[k]]) # cria um objeto com o número de conceitos avaliados, a partir da posição [[k]] da lista 'con' (ou seja, o número de individuos que foram avaliados)
        
        if (coord==TRUE) # teste para o argumento 'coord', caso seja TRUE os dados são de coordenadas geográficas dos entrevistados
        {
          mat.coord= matrix(unlist(dist[k]), length(dist[[k]][,1]), 2) # recria uma matriz a partir da seleção da posição [k] da lista "dist"
        
          mat.dist= as.matrix(dist(mat.coord, diag=T, upper=T)) #cria uma matriz de distância entre os indivíduos, incluíndo a diagonal e o triãngulo superior
          
          diag(mat.dist)=NA # garante que a diagonal dessa matriz seja de NAs
        }   
        
        if (coord==FALSE) # teste para o argumento 'coord', caso seja FALSE os dados já se referem a alguma medida de distância entre os entrevistados
        {
          mat.dist= as.matrix(unlist(dist[[k]]))#, individuos, individuos) # recria uma matriz a partir da seleção da posição [k] da lista "dist"
          
          diag(mat.dist)=NA # garante que a diagonal dessa matriz seja de NAs
        }
        
        mat.con= matrix(NA, individuos, individuos) # cria uma matriz de NAs com o número de linhas e colunas iqual ao que seria o número dos indivíduos entrevistados
        
        for(l in 1:length(con[[k]])) # inicia um ciclo para preencher os conceitos da matriz 'mat.con' para as respectivas posições da lista 'con'
        {
          mat.con[l,]= con[[k]][l] # toda a linha daquele ciclo [l] é preenchida com o seu respectivo conceito na posição [l] do conjunto [[k]] da lista 'con'
          mat.con[l, l]= NA # as posições da diagonal são preenchidas com NA, uma vez que não interessa comparar o conceito de uma pessoa com ela mesma
        }
        
        mat.dist.melt= melt(mat.dist) # cria um objeto com a matriz 'mat.dist' convertida em um dataframe que será necessário para o plotar as cores do heat map
        mat.con.melt= melt(t(mat.con)) # cria um objeto com a matriz 'mat.con' convertida em um dataframe que será necessário para o plotar os valores do heat map
        
        all.plots[[k]] <<- # atribui o plot abaixo para a posição [[k]] da lista 'all.plot'
          ggplot(mat.dist.melt, aes(Var1, Var2)) + # cria uma área de plotagem dividida em células que representam as combinações dos diferentes indivíduos avaliados
          scale_x_discrete(limits=c(1:individuos)) + # plota os valores no número de indivíduos no eixo x
          scale_y_reverse(breaks=seq(1, individuos, 1)) + # inverte o eixo y para que o plot fique mais parecido com o modelo usual de plotar matrizes de correlação e coloca os valores no número de indivíduos
          geom_tile(aes(fill = mat.dist.melt$value), color="black") + # preenche a cor de fundo das células de acordo com valores de distância entre os indivíduos e traça linhas pretas ao redor de cada célula
          scale_fill_gradient(slabel[k], low = lcol[k], high = hcol[k]) + # muda as cores de fundo para uma escala de cores específica indicada pelos argumentos 'lcol' e 'hcol' e muda o nome da legenda de cores para 'slabel', sempre usando a posição [k] dos argumentos
          geom_text(label = mat.con.melt$value, na.rm= TRUE, color= tcol[k]) + # acrescenta os valores dos conceitos de cada indivíduo na cor especificada no argumento 'tcol'
          labs(title= main[k], x = label[k], y= label[k]) + # acrescenta o nome do título e dos eixos, paras as respectivas posições [k]
          theme_classic() # retira o cinza de fundo da área de plotagem
      } 
    )
  
  multiplot(plotlist = all.plots) # usa a função 'multiplot' para plotar todos os heat maps de uma vez
  
  cat("Esta função engloba uma outra função chamada 'multiplot', para referência ver http://www.cookbook-r.com/Graphs/Multiple_graphs_on_one_page_%28ggplot2%29/ ou http://www.peterhaschke.com/r/2013/04/24/MultiPlot.html") # apresenta uma mensagem no console sobre o uso da função 'multiplot'
  
} # ufa fim.....
05_curso_antigo/r2016/alunos/trabalho_final/karina.tisovec/cod_b_ka.txt · Última modificação: 2020/08/12 06:04 (edição externa)