Agora sim Hélio,
Agora com correlação direta e inversa e com cores, segue CRM:
#Pacote
require(gplots)
#Variáveis artificiais
dados<-runif(1000)
dados<-(dados*100)+c(1:500, 500:1)
dados<-matrix(dados,nrow=100,ncol=10)
dados<-as.data.frame(dados)
names(dados)<-c("var1", "var2","var3","var4","var5","var6","var7","var8","var9","var10")
#Função by Walmes
pn <- function(X){crossprod(!is.na(X))}
cor.prob <- function(X){
pair.SampSize <- pn(X)
above1 <- row(pair.SampSize) < col(pair.SampSize)
pair.df <- pair.SampSize[above1] - 2
R <- cor(X, use="pair")
above2 <- row(R) < col(R)
r2 <- R[above2]^2
Fstat <- (r2 * pair.df)/(1 - r2)
R[above2] <- 1 - pf(Fstat, 1, pair.df)
R
}
correla <- round(cor.prob(dados),4)
#Função by Helio
sig<-0.05## Significância pos
rP<-0.50 ## Correlação positiva
rN<--0.50## Correlação negativa
cor.probC <- function(x){
results <- x
ifelse(row(x)< col(x),ifelse(x<=sig,NA,x),ifelse(x<=rP&x>=rN,NA,x))
}
cr <- cor.probC(correla)
colnames(cr) <- names(dados)
rownames(cr) <- names(dados)
cr
#
#Plota a matriz
paleta<- colorRampPalette(c(rgb(0.96,0.96,1), rgb(0.1,0.1,0.9)), space = "rgb")
xval <- formatC(cr, format="f", digits=2)
x_hm <- heatmap.2(cr, Rowv=FALSE, Colv=FALSE, dendrogram="none",col=paleta,
trace="none", cellnote=xval, notecol="black", notecex=0.8)
#
-- ====================================================================== Alexandre dos Santos Proteção Florestal IFMT - Instituto Federal de Educação, Ciência e Tecnologia de Mato Grosso Campus Cáceres Caixa Postal 244 Avenida dos Ramires, s/n Bairro: Distrito Industrial Cáceres - MT CEP: 78.200-000 Fone: (+55) 65 8132-8112 (TIM) (+55) 65 9686-6970 (VIVO) e-mails:alexandresantosbr@yahoo.com.br alexandre.santos@cas.ifmt.edu.br Lattes: http://lattes.cnpq.br/1360403201088680 ======================================================================
Em 02/09/2015 22:29, Hélio Gallo Rocha escreveu:
Alexandre. Estou num celular, mas acho que incluindo o caracter & no campo relativo a correlação, vai funcionar
Em 02/09/2015 22:36, "ASANTOS [via R-br]" <ml-node+s2285057n4665035h53@n4.nabble.com> escreveu:
Boa noite Helio,
O problema é que a função some também com variáveis
significantes mas inversamente correlacionadas, se altero
ifelse(x>=0.08,NA,x), tenho o problema inverso. Veja as alterações que
fiz, também criei uma estrutura de correlação um pouco melhor nos dados
artificiais. Outro problema para colorir estão sendo os NA's, mas acho
que estamos chegando lá, segue o CRM:
#Variáveis artificiais
dados<-runif(1000)
dados<-(dados*100)+c(1:500, 500:1)
dados<-matrix(dados,nrow=100,ncol=10)
dados<-as.data.frame(dados)
names(dados)<-c("var1",
"var2","var3","var4","var5","var6","var7","var8","var9","var10")
#Função by Walmes
pn <- function(X){crossprod(!is.na(X))}
cor.prob <- function(X){
pair.SampSize <- pn(X)
above1 <- row(pair.SampSize) < col(pair.SampSize)
pair.df <- pair.SampSize[above1] - 2
R <- cor(X, use="pair")
above2 <- row(R) < col(R)
r2 <- R[above2]^2
Fstat <- (r2 * pair.df)/(1 - r2)
R[above2] <- 1 - pf(Fstat, 1, pair.df)
R
}
correla <- round(cor.prob(dados),4)
#Função by Helio
sig<-0.05## Significância
r<-0.30 ## Correlação
cor.probC <- function(x){
results <- x
ifelse(row(x)< col(x),ifelse(x<=sig,NA,x),ifelse(x<=r,NA,x))
}
cr <- cor.probC(correla)
colnames(cr) <- names(dados)
rownames(cr) <- names(dados)
cr
#
Abraço,
--
======================================================================
Alexandre dos Santos
Proteção Florestal
IFMT - Instituto Federal de Educação, Ciência e Tecnologia de Mato Grosso
Campus Cáceres
Caixa Postal 244
Avenida dos Ramires, s/n
Bairro: Distrito Industrial
Cáceres - MT CEP: 78.200-000
Fone: (+55) 65 8132-8112 (TIM) (+55) 65 9686-6970 (VIVO)
e-mails:[hidden email]
[hidden email]
Lattes: http://lattes.cnpq.br/1360403201088680
======================================================================
Em 02/09/2015 12:09, Hélio Gallo Rocha escreveu:
> var1<-sort(rnorm(30,1), decreasing = TRUE)
> var2<-rnorm(30,10)
> var3<-sort(rnorm(30,22))
> var4<-sort(rnorm(30,10))
> var5<-sort(rnorm(30,0.5), decreasing = TRUE)
> var6<-sort(rnorm(30,25), decreasing = TRUE)
> var7<-rnorm(30,10)
> dados<-cbind(var1,var2,var3,var4,var5,var6,var7)
_______________________________________________
R-br mailing list
[hidden email]
https://listas.inf.ufpr.br/cgi-bin/mailman/listinfo/r-br
Leia o guia de postagem (http://www.leg.ufpr.br/r-br-guia) e forneça código mínimo reproduzível.
If you reply to this email, your message will be added to the discussion below:http://r-br.2285057.n4.nabble.com/R-br-Exibicao-de-matriz-de-correlacao-dada-uma-condicao-tp4664911p4665035.html
_______________________________________________ R-br mailing list R-br@listas.c3sl.ufpr.br https://listas.inf.ufpr.br/cgi-bin/mailman/listinfo/r-br Leia o guia de postagem (http://www.leg.ufpr.br/r-br-guia) e forneça código mínimo reproduzível.
-- ====================================================================== Alexandre dos Santos Proteção Florestal IFMT - Instituto Federal de Educação, Ciência e Tecnologia de Mato Grosso Campus Cáceres Caixa Postal 244 Avenida dos Ramires, s/n Bairro: Distrito Industrial Cáceres - MT CEP: 78.200-000 Fone: (+55) 65 8132-8112 (TIM) (+55) 65 9686-6970 (VIVO) e-mails:alexandresantosbr@yahoo.com.br alexandre.santos@cas.ifmt.edu.br Lattes: http://lattes.cnpq.br/1360403201088680 ======================================================================