#########################
# 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.....