Testando conceitos morfológicos a priori

Dados necessários:

• dados.morfo = sua matriz de dados 1 amostra por linha e colunas morfológicas (apenas variáveis numéricas, mas pode ter múltiplos valores por célula separados por ';'). Nomes das linhas = identificadores das amostras.
• dados.apriori = sua matriz de definição dos conceitos (grupos) a priori. 1 linha por grupo (conceito). Nome de linha da matrix = nome do conceito. Apenas variáveis numéricas, mas pode ter múltiplos valores (e.g. max e mínimos) por célula separados por ';'.

Resultados:

• 1 tabela com o número de amostras que melhor satisfazem os conceitos (classificadas em classe de XX% de variáveis que satisfazem a condição);
• 1 figura mostrando a matriz de confusão entre conceitos quanto à amostras que satisfazem mais de um conceito, se houver;
• 1 figura mostrando as distribuições do número (e porcentagem) de variáveis que satisfazem o melhor conceito para cada amostra;
• 1 uma classificação das amostras segundo o melhor conceito que ela satisfaz (ou por número mínimo de amostras) para ser usada na segunda etapa (Teste de Classificação).

#garantir que tem as mesmas variáveis em ambos os dados (e as colunas estão escritas do mesmo jeito)
var1 = colnames(dados.morfo.brutos)
var2 = colnames(dados.apriori)
vars = var1[var1%in%var2]
print(paste(length(vars),"variáveis são comuns a ambas as tabelas"))
 
#CRIA FUNCAO PARA PERGUNTA SOBRE NAs NUM VETOR, retorna TRUE se não tem NAs, e FALSE se tem
temna <- function(x) { 
  xx = x[!is.na(x)]
  if (length(xx)==length(x)) {return(T)} else {return(F)}
}
#para cada amostra (linha em dados.morfo), compara com os conceitos (linhas) em dados.apriori 
#e extrair o(s) conceito(s) ou grupos a priori em que a amostra melhor se encaixa (maior porcentagem de variáveis em que a variação da amostra é igual ou contida na variação explícita do conceito)
 
#cria um objeto vazio para salvar os resultados da comparação de cada amostra
res = NULL
#para a (amostra) variando de 1 ao número de linhas em dados.morfo
for(a in 1:nrow(dados.morfo)) {
 
    #pega os dados da amostra (a) a ser testada
  d1 = dados.morfo[a,vars]
 
  #pega o identificador da amostra (nome da linha)
  idd = rownames(dados.morfo)[a]
 
  #cria um objeto para subresultados (comparacao da amostra com cada conceito em dados.apriori) 
  subres = NULL
  #compara a amostra com todos os grupos/conceito (linhas) em dados.apriori
  for(b in 1:nrow(dados.apriori)) {
 
    #pega os dados morfológicos do conceito (b)
    tb= dados.apriori[b,vars]
    #pega o nome desse conceito
    nomeclasse = rownames(dados.apriori)[b]
    #pega os dados da amostra (a) e do conceito (b) e remove as colunas quem algum NA, para comparar apenas o que pode (há) ser comparado
    #junta a linha do conceito (tb) com alinha da amostra(d1)
    dd = rbind(CONCEITO=tb,AMOSTRA=d1)
    #perguntado quais colunas (variaveis) pode comparar (i.e. não tem (NA) que impede comparação)
    x = apply(dd,2,temna)
    #filtra apenas essas colunas que tem valores para comparar
    ddd = data.frame(dd[,x],stringsAsFactors = F)
    colnames(ddd) = colnames(dd)[x]
    dd = ddd
 
    ##compara amostra e conceito em todos os valores possíveis
    #cria objeto para salvar resultado da comparacao de cada variavel
    cols = NULL
    for(t in 1:ncol(dd)) {
      #pega o valor da amostra
      v2 = dd['AMOSTRA',t]
      #se o valor for caractere talvez tenha mais de 1 número
      #checa e separa valores se for o caso, convertendo para numérico
      if (is.character(v2)) {
        v2 = strsplit(v2,";")[[1]]
        v2 = v2[v2!=""]
        v2 = as.numeric(v2)
      }
      #pega o valor do conceito (primeiro)
      v1 = dd['CONCEITO',t]
      #se for caractere, converte em numerico
      if (is.character(v1)) { 
        v1 = strsplit(v1,";")[[1]]
        v1 = v1[v1!=""]
        v1 = as.numeric(v1)
      }  
      #a variacao da minha amostra esta dentro da variacao do grupo em dado conceito quando se tem mais de dois valores para cada um (vl será T ou F)
      if (length(v1)>1 & length(v2)>1) {
        vl = min(v2)>=min(v1) & max(v2)<=max(v1)
      }
      #o mesmo mas quando há apenas 1 valor da amostra e mais de 1 valor no conceito
      if (length(v2)==1 & length(v1)>1) {
        vl = v2>=min(v1) & v2<=max(v1)
      }
      #o mesmo, mas quando ambos, amostra e conceito tem apenas 1 valor cada
      if (length(v2)==1 & length(v1)==1) {
        vl = v2==v1
      }
      #por ultimo, quando tem dois ou mais valores na amostra e apenas 1 valor no conceito (neste caso, o valor do conceito deve estar na amplitude de variação dos valores da amostra)
      if (length(v2)>1 & length(v1)==1) {
        vl = v1>=min(v2) & v1<=max(v2)
      }
      #junta o resultado com as demais comparações para o par (amostra vs. conceito)
      cols = c(cols,vl)
    }
    #qual a porcentagem de variaveis que a amostra satisfaz a variacao do conceito?
    porc = round((sum(cols)/length(cols))*100,1)
 
    #salva o resultado da comparacao amostra vs. conceito 
    rr = data.frame(IDENTIFICADOR.AMOSTRA=idd,NOME.CONCEITO=nomeclasse,PORC.VARIAVEIS=porc,N.VARIAVEIS.MATCH =sum(cols),N.VARIAVEIS.USADAS =length(cols))
    #junta com o resultado das outras comparacoes
    subres = rbind(subres,rr)
  }
 
  #QUAL A COMPARAÇÃO amostra vs. conceito COM MAIOR ACERTO?
  #seleciona a(s) comparacao(oes) com maior porcentagem de match
  mm = max(subres$PORC.VARIAVEIS, na.rm=T)
  vl = subres$PORC.VARIAVEIS==mm & !is.na(subres$PORC.VARIAVEIS)
  if (sum(vl)>1) {
    #se houver mais de um match máximo avisa
    print(paste(idd," tem ",mm,"% de acerto com ",sum(vl),"conceitos:",paste(subres$NOME.CONCEITO[vl],collapse = " "),sep=""))
  }
  #filtra da comparação apenas os conceitos que tem o máximo de acerto para a amostra
  subres = subres[vl,]
  #junta com o resultado de todas as comparações amostra vs. conceitos
  res = rbind(res,subres)  
}

#resume os dados por grupo a priori
#define funcao para pegar a classes de acerto segundo a porcentagem
pegaclasse <- function(x) {
  if (x<30) {r = "0_30"}
  if (x>=30 & x<60) {r = "30_60"}
  if (x>=60 & x<80) {r = "60_80"}
  if (x>=80 & x<90) {r = "80_90"}
  if (x>=90) {r = "90_100"}
  return(r)
}  
#aplica essa funcao
vv = sapply(res$PORC.VARIAVEIS,pegaclasse)  
#resultado final
tb = table(res$NOME.CONCEITO,vv)
tb = as.data.frame.matrix(tb,stringsAsFactors = F)
#pega o numero total de amostras por conceito
mm = apply(tb,1,sum)
tb$TOTAL = mm
mm2 = apply(tb,2,sum)
tb = rbind(tb,TOTAL=mm2)
tb
#salva o resultado
write.table(tb,file="tabela_resultadoconceito.csv",sep="\t",row.names=T,col.names = T,quote=T,na="")

Vai precisar da função plotamatriz(), que gera a figura da matriz de confusão. Você encontra ela no SCRIPT 02 - Testando Grupos.

#quantas amostras tem mais de 1 predicao maxima
vl = duplicated(res$IDENTIFICADOR.AMOSTRA)
sum(vl)
 
#SE HOUVER 
#ESSAS AMOSTRAS DUPLICADAS INDICAM INDIVIDUOS QUE TEM A MESMA SIMILARIDADE
#COM MAIS DE 1 CONCEITO
#faz um matriz de confusão para essas amostras
#mostrando o número de amostras com match em pares de conceitos
ids = res$IDENTIFICADOR.AMOSTRA[vl]
vl2 = res$IDENTIFICADOR.AMOSTRA%in%ids
#quem confundiu com quem
rr = res[vl2,]
gps = unique(rr$NOME.CONCEITO)
idd = unique(rr$IDENTIFICADOR.AMOSTRA)
mm = matrix(0,nrow=length(gps),ncol=length(gps),dimnames = list(gps,gps))
for(i in 1:length(idd)) {
  id = idd[i]
  vll = rr$IDENTIFICADOR.AMOSTRA==id & !is.na(rr$IDENTIFICADOR.AMOSTRA)
  cl=as.vector(rr$NOME.CONCEITO)[vll]
  mm[cl[1],cl[2]] =mm[cl[1],cl[2]]+1
  #mm[cl[2],cl[1]] =mm[cl[2],cl[1]]+1
}
conceitos = colnames(mm)
mm = mm[sort(conceitos),sort(conceitos,decreasing = T)]
#PLOTA ESSA MATRIZ DE CONFUSAO
#precisa da funcao plotamatriz que está no SCRIPT-02
#define cores do backgroun e texto
bg.cols= mm
txt.cols = mm
#se for 0 é branco
bg.cols[mm==0] = gray(level=1)
txt.cols[mm==0] = gray(level=1)
#se for 1 é cinza claro
bg.cols[mm==1] = gray(level=0.8)
txt.cols[mm==1] = gray(level=0)
#se for entre 1 e 5 é um pouco mais escuro
bg.cols[mm>1 & mm<=5] = gray(level=0.6)
txt.cols[mm>1 & mm<=5] = gray(level=0)
bg.cols[mm>5 & mm<=10] = gray(level=0.4)
txt.cols[mm>5 & mm<=10] = gray(level=1)
#se for > 10 o fundo é preto e o texto branco
bg.cols[mm>10] = gray(level=0)
txt.cols[mm>10] = gray(level=1)
#one for 0 coloca NA, isso não é plotado
mm[mm==0] = NA
#mm[upper.tri(mm)] = NA
#mm[diag(mm)] = NA
pdf(file='amostrasEmConceitosDuplicados.pdf',width=8,height=6)
par(mar=c(1,16,16,1))
plotamatriz(mm,bg.cols=bg.cols,txt.cols=txt.cols,valcex=0.7, cexaxis = 0.7)
dev.off()

Este script faz uma figura composta mostrando a distribuição do número (e porcentagem do disponível) das variáveis utilizadas nas comparações amostra vs. conceito. Ele também ressalta os valores para as amostras que satisfazem mais de 1 conceito (item acima). Se não houver ajuste o script para obter a figura para essas distribuições.

#essas amostras duplicadas se confundem entre conceitos
#porque elas foram comparadas por poucas variáveis?
#ou porque são amostras que tem baixa porcentagem no melhor conceito
#ou seja o número de variáveis usadas para compará-las com conceito
#foi menor que o esperado?
#quantas amostras tem mais de 1 predicao maxima
vl = duplicated(res$IDENTIFICADOR.AMOSTRA)
sum(vl)
ids = res$IDENTIFICADOR.AMOSTRA[vl]
vl2 = res$IDENTIFICADOR.AMOSTRA%in%ids
pdf(file='amostrasEmConceitosDuplicados_efeitoamostral.pdf',width=8,height=10)
par(mar=c(5,4,3,2),mfrow=c(2,1))
#numero de variáveis geral para não duplicados
nvargeral = res$N.VARIAVEIS.MATCH
#numero de variáveis para os registros duplicados
nvardups = res$N.VARIAVEIS.MATCH[vl2]
#plot isso num histograma
hist(nvargeral,breaks=20,col='gray95', xlab="Número de variáveis que satisfazem o conceito",main="Comparação Amostras vs. Conceitos")
hist(nvardups,breaks=20,add=T,density=5,col ='red',angle=45)
legend('topright',legend=c("Todas as amostras","Amostras com mais \nde um conceito máximo"),density=c(NA,5),angle=c(NA,45),bty='n',cex=0.8,fill=c("gray95","red"),border=c("black","red"),y.intersp = 1.5)
 
#agora a porcentagem de acerto
nvargeral = res$PORC.VARIAVEIS
nvardups = res$PORC.VARIAVEIS[vl2]
hist(nvargeral,breaks=20,col='gray95', xlab="Porcentagem de variáveis usadas que satisfazem o conceito",main="Comparação Amostras vs. Conceitos")
hist(nvardups,breaks=20,add=T,density=5,col ='red',angle=45)
legend('topleft',legend=c("Todas as amostras","Amostras com mais \nde um conceito máximo"),density=c(NA,5),angle=c(NA,45),bty='n',cex=0.8,fill=c("gray95","red"),border=c("black","red"),y.intersp = 1.5)
dev.off()

Salva a classificação das amostras segundo o conceito em que ela melhor se encaixa, incluindo o número absoluto e porcentagem de variáveis que satisfazem a classe atribuída. Amostras que satisfazem mais de um conceito, se houver, são deixadas sem classe, porque elas podem representar (a) amostras que tem poucas variáveis para comparar com os conceitos; ou (b) amostras que são muito diferentes e por isso não se encaixam em nenhum conceito (isso pode entender pela figura das distribuições). Essa classificação pode ser usada:

• testar essa classificação seguindo o SCRIPT 02 - Testando Grupos.
• produzir um modelo preditivo (SVM, LDA, naiveBayes) com as amostras classificadas com alta porcentagem de variáveis (um limite a seu critério) e reclassificar as demais amostras segundo esse modelo obtendo uma classificação final de todas as tuas amostras.

#cria uma copia do resultado eliminando os duplicados
ores = res
vl = duplicated(ores$IDENTIFICADOR.AMOSTRA)
#se há duplicados
if (sum(vl)>0) {
  #elimina linhas duplicadas
  ores = ores[!vl,]
  rownames(ores) = ores$IDENTIFICADOR.AMOSTRA
  #pega identificador dessas amostras  
  ids = res$IDENTIFICADOR.AMOSTRA[vl]
  #desclassifica elas
  ores[ids,c("NOME.CONCEITO", "PORC.VARIAVEIS", "N.VARIAVEIS.MATCH", "N.VARIAVEIS.USADAS")] = NA
}  else {
  rownames(ores) = ores$IDENTIFICADOR.AMOSTRA
}
colnames(ores)[2] ="MELHOR.CONCEITO"
write.table(ores,file='reclassificacaoSegundoConceitos.csv',sep='\t',na='',row.names = F)