Usando distribuição uniforme para gerar amostras aleatórias correlacionadas em R

[Em questões recentes, eu estava pensando em gerar vetores aleatórios em R e queria compartilhar essa "pesquisa" como uma sessão de perguntas e respostas independente em um ponto específico.]

A geração de dados aleatórios com correlação pode ser feita usando a decomposição de Cholesky da matriz de correlação aqui , como refletido em postagens anteriores aqui e aqui .$C = LL^{T}$

A questão que quero abordar é como usar a distribuição uniforme para gerar números aleatórios correlacionados de diferentes distribuições marginais em R .

Desde que a pergunta é

"como usar a distribuição Uniform para gerar números aleatórios correlacionados a partir de diferentes distribuições marginais em "$\mathbb{R}$

e não apenas variáveis ​​aleatórias normais, a resposta acima não produz simulações com a correlação pretendida para um par arbitrário de distribuições marginais em .$\mathbb{R}$

O motivo é que, para a maioria das cdfs e , quando onde indica o cdf normal padrão.G Y cor ( X , Y ) ≠ cor ( G - 1 X ( Φ ( X ) , G - 1 Y ( Φ ( Y ) ) , ( X , Y ) ∼ N 2 ( 0 , Σ ) , $G_X$$G_Y$

A saber, aqui está um contra-exemplo com um Exp (1) e um Gamma (.2,1) como meu par de distribuições marginais em .$\mathbb{R}$

library(mvtnorm)
#correlated normals with correlation 0.7
x=rmvnorm(1e4,mean=c(0,0),sigma=matrix(c(1,.7,.7,1),ncol=2),meth="chol")
cor(x[,1],x[,2])
  [1] 0.704503
y=pnorm(x) #correlated uniforms
cor(y[,1],y[,2])
  [1] 0.6860069
#correlated Exp(1) and Ga(.2,1)
cor(-log(1-y[,1]),qgamma(y[,2],shape=.2))
  [1] 0.5840085

Outro contra-exemplo óbvio é quando é o cdf de Cauchy, caso em que a correlação não é definida.$G_X$

Para dar uma imagem mais ampla, aqui está um código R onde e são arbitrários:G $G_X$$G_Y$

etacor=function(rho=0,nsim=1e4,fx=qnorm,fy=qnorm){
  #generate a bivariate correlated normal sample
  x1=rnorm(nsim);x2=rnorm(nsim)
  if (length(rho)==1){
    y=pnorm(cbind(x1,rho*x1+sqrt((1-rho^2))*x2))
    return(cor(fx(y[,1]),fy(y[,2])))
    }
  coeur=rho
  rho2=sqrt(1-rho^2)
  for (t in 1:length(rho)){
     y=pnorm(cbind(x1,rho[t]*x1+rho2[t]*x2))
     coeur[t]=cor(fx(y[,1]),fy(y[,2]))}
  return(coeur)
  }

Brincar com cdfs diferentes me levou a destacar esse caso especial de uma para e uma distribuição log-Normal para : G X G $\chi^2_3$$G_X$$G_Y$

rhos=seq(-1,1,by=.01)
trancor=etacor(rho=rhos,fx=function(x){qchisq(x,df=3)},fy=qlnorm)
plot(rhos,trancor,ty="l",ylim=c(-1,1))
abline(a=0,b=1,lty=2)

que mostra a que distância da diagonal a correlação pode estar.

Um aviso final Dadas duas distribuições arbitrárias e , o intervalo de valores possíveis de não é necessariamente . O problema pode, portanto, não ter solução.G Y cor ( X , Y ) ( - 1 , 1 $G_X$$G_Y$$\text{cor}(X,Y)$$(-1,1)$

Eu escrevi o correlatepacote. As pessoas disseram que é promissor (digno de uma publicação no Journal of Statistical Software), mas eu nunca escrevi o artigo para ele porque escolhi não seguir uma carreira acadêmica.

Acredito que o correlatepacote não mantido ainda esteja no CRAN.

Ao instalá-lo, você pode fazer o seguinte:

require('correlate')
a <- rnorm(100)
b <- runif(100)
newdata <- correlate(cbind(a,b),0.5)

O resultado é que os novos dados terão uma correlação de 0,5, sem alterar as distribuições univariadas de ae b(os mesmos valores estão lá, eles apenas serão movidos até a correlação 0,5 multivariada ser atingida.

Vou responder às perguntas aqui, desculpe pela falta de documentação.

1. Gere duas amostras de dados correlacionados a partir de uma distribuição aleatória normal padrão após uma correlação predeterminada .

   Como exemplo, vamos escolher uma correlação r = 0,7 e codificar uma matriz de correlação, como:

   (C <- matrix(c(1,0.7,0.7,1), nrow = 2)) [,1] [,2] [1,] 1.0 0.7 [2,] 0.7 1.0

   Podemos usar mvtnormpara gerar agora essas duas amostras como um vetor aleatório bivariado:

   set.seed(0)

   SN <- rmvnorm(mean = c(0,0), sig = C, n = 1e5)resultando em dois componentes de vetor distribuídos como ~ e com a . Ambos os componentes podem ser extraídos da seguinte maneira:$N(0, 1)$cor(SN[,1],SN[,2])= 0.6996197 ~ 0.7

   X1 <- SN[,1]; X2 <- SN[,2]

   Aqui está o gráfico com a linha de regressão sobreposta:

   

2. Use a Transformação Integral de Probabilidade aqui para obter um vetor aleatório bivariado com distribuições marginais ~ e a mesma correlação :$U(0, 1)$

   U <- pnorm(SN)- então estamos alimentando pnormo SNvetor para encontrar (ou ). No processo, preservamos o .Φ ( S N $erf(SN)$$\Phi(SN)$cor(U[,1], U[,2]) = 0.6816123 ~ 0.7

   Novamente, podemos decompor o vetor U1 <- U[,1]; U2 <- U[,2]e produzir um gráfico de dispersão com distribuições marginais nas bordas, mostrando claramente sua natureza uniforme:

   

3. Aplique o método de amostragem por transformada inversa aqui para finalmente obter o bivetor de pontos igualmente correlacionados pertencentes a qualquer família de distribuição que nos propusemos a reproduzir.

   A partir daqui, podemos gerar apenas dois vetores distribuídos normalmente e com variações iguais ou diferentes . Por exemplo: Y1 <- qnorm(U1, mean = 8,sd = 10)e Y2 <- qnorm(U2, mean = -5, sd = 4), que manterá a correlação desejada cor(Y1,Y2) = 0.6996197 ~ 0.7,.

   Ou opte por diferentes distribuições. Se as distribuições escolhidas são muito diferentes, a correlação pode não ser tão precisa. Por exemplo, vamos U1seguir uma distribuição com 3 df e um exponencial com a = 1: e The . Aqui estão os respectivos histogramas:$t$U2$\lambda$Z1 <- qt(U1, df = 3)Z2 <- qexp(U2, rate = 1)cor(Z1,Z2) [1] 0.5941299 < 0.7

   

Aqui está um exemplo de código para todo o processo e os marginais normais:

Cor_samples <- function(r, n, mean1, mean2, sd1, sd2){
C <- matrix(c(1,r,r,1), nrow = 2)
require(mvtnorm)
SN <- rmvnorm(mean = c(0,0), sig = C, n = n)
U <- pnorm(SN)
U1 <- U[,1]
U2 <- U[,2]

 Y1 <<- qnorm(U1, mean = mean1,sd = sd1) 
 Y2 <<- qnorm(U2, mean = mean2,sd = sd2) 

sample_measures <<- as.data.frame(c(mean(Y1), mean(Y2), sd(Y1), sd(Y2), cor(Y1,Y2)), names<-c("mean Y1", "mean Y2", "SD Y1", "SD Y2", "Cor(Y1,Y2)"))
sample_measures
}

Para comparação, reuni uma função baseada na decomposição de Cholesky:

Cholesky_samples <- function(r, n, mean1, mean2, sd1, sd2){
C <- matrix(c(1,r,r,1), nrow = 2)
L <- chol(C)
X1 <- rnorm(n)
X2 <- rnorm(n)
X <- rbind(X1,X2)

Y <- t(L)%*%X
Y1 <- Y[1,]
Y2 <- Y[2,]

N_1 <<- Y[1,] * sd1 + mean1
N_2 <<- Y[2,] * sd2 + mean2

sample_measures <<- as.data.frame(c(mean(N_1), mean(N_2), sd(N_1), sd(N_2), cor(N_1, N_2)), 
                  names<-c("mean N_1", "mean N_2", "SD N_1", "SD N_2","cor(N_1,N_2)"))
sample_measures
}

Tentando ambos os métodos para gerar amostras correlacionadas (digamos, ) distribuídas ~ e que obtemos, definindo :N ( 97 , 23 ) N ( 32 , 8 $r=0.7$$N(97,23)$$N(32,8)$set.seed(99)

Usando o uniforme:

cor_samples(0.7, 1000, 97, 32, 23, 8)
           c(mean(Y1), mean(Y2), sd(Y1), sd(Y2), cor(Y1, Y2))
mean Y1                                            96.5298821
mean Y2                                            32.1548306
SD Y1                                              22.8669448
SD Y2                                               8.1150780
cor(Y1,Y2)                                          0.7061308

e Usando o Cholesky:

Cholesky_samples(0.7, 1000, 97, 32, 23, 8)
             c(mean(N_1), mean(N_2), sd(N_1), sd(N_2), cor(N_1, N_2))
mean N_1                                                   96.4457504
mean N_2                                                   31.9979675
SD N_1                                                     23.5255419
SD N_2                                                      8.1459100
cor(N_1,N_2)                                                0.7282176