R을 사용하여“병렬 세트”플롯을 만들 수 있습니까?


16

Tormod 질문 ( 여기에 게시 됨 ) 덕분에 Parallel Sets 플롯을 발견했습니다. 다음은 그 모습을 보여주는 예입니다. 여기에 이미지 설명을 입력하십시오 (타이타닉 데이터 셋의 시각화입니다. 예를 들어, 살아남지 못한 대부분의 여성이 세 번째 클래스에 속하는 방법을 보여줍니다 ...)

R을 사용하여 그러한 음모를 재현 할 수 있기를 원합니다. 가능합니까?

고마워, 탈


1
그래픽에 대한 아이디어를 얻으려면 항상 R 그래프 갤러리를 확인하십시오. 여기에 요청한 것과 비슷한 것이 있습니다 : R Graph Gallery parallel . 태그 클라우드에서 병렬을 클릭하여 찾았지만 더 나은 옵션이있을 수 있습니다.
Nick Sabbe 2016 년

1
고마워 닉. 그러나 이것은 코드를 크게 조정하지 않고 범주 형 데이터에는 작동하지 않습니다 (이를 빌드하는 데 가장 좋은 기능의 기초가 아닐 수도 있습니다). 누군가가 이미 비슷한 일을했을 수 있기를 바랍니다.
Tal Galili

답변:


25

Hadley의 의견에 따라 기본 그래픽 만 사용하는 버전이 있습니다. (이전 버전의 경우 편집 기록을 참조하십시오).

세 번째 시도

parallelset <- function(..., freq, col="gray", border=0, layer, 
                             alpha=0.5, gap.width=0.05) {
  p <- data.frame(..., freq, col, border, alpha, stringsAsFactors=FALSE)
  n <- nrow(p)
  if(missing(layer)) { layer <- 1:n }
  p$layer <- layer
  np <- ncol(p) - 5
  d <- p[ , 1:np, drop=FALSE]
  p <- p[ , -c(1:np), drop=FALSE]
  p$freq <- with(p, freq/sum(freq))
  col <- col2rgb(p$col, alpha=TRUE)
  if(!identical(alpha, FALSE)) { col["alpha", ] <- p$alpha*256 }
  p$col <- apply(col, 2, function(x) do.call(rgb, c(as.list(x), maxColorValue = 256)))
  getp <- function(i, d, f, w=gap.width) {
    a <- c(i, (1:ncol(d))[-i])
    o <- do.call(order, d[a])
    x <- c(0, cumsum(f[o])) * (1-w)
    x <- cbind(x[-length(x)], x[-1])
    gap <- cumsum( c(0L, diff(as.numeric(d[o,i])) != 0) )
    gap <- gap / max(gap) * w
    (x + gap)[order(o),]
  }
  dd <- lapply(seq_along(d), getp, d=d, f=p$freq)
  par(mar = c(0, 0, 2, 0) + 0.1, xpd=TRUE )
  plot(NULL, type="n",xlim=c(0, 1), ylim=c(np, 1),
       xaxt="n", yaxt="n", xaxs="i", yaxs="i", xlab='', ylab='', frame=FALSE)
  for(i in rev(order(p$layer)) ) {
     for(j in 1:(np-1) )
     polygon(c(dd[[j]][i,], rev(dd[[j+1]][i,])), c(j, j, j+1, j+1),
             col=p$col[i], border=p$border[i])
   }
   text(0, seq_along(dd), labels=names(d), adj=c(0,-2), font=2)
   for(j in seq_along(dd)) {
     ax <- lapply(split(dd[[j]], d[,j]), range)
     for(k in seq_along(ax)) {
       lines(ax[[k]], c(j, j))
       text(ax[[k]][1], j, labels=names(ax)[k], adj=c(0, -0.25))
     }
   }           
}

data(Titanic)
myt <- subset(as.data.frame(Titanic), Age=="Adult", 
              select=c("Survived","Sex","Class","Freq"))
myt <- within(myt, {
  Survived <- factor(Survived, levels=c("Yes","No"))
  levels(Class) <- c(paste(c("First", "Second", "Third"), "Class"), "Crew")
  color <- ifelse(Survived=="Yes","#008888","#330066")
})

with(myt, parallelset(Survived, Sex, Class, freq=Freq, col=color, alpha=0.2))

Aaron, 와우, 환상적인 답변-V를 두 번 표시 할 수 있으면 좋겠습니다. 감사합니다!
탈 Galili

2
당신이 그것을 좋아해서 다행입니다. 재미 있었어요. :) 유일한 까다로운 부분은 바가 시작하고 끝나는 곳을 얻는 것입니다 ( getp하위 기능에 있음). 나머지는 폴리곤을 그립니다.
Aaron-복원 모니카

1
또 다른 panel.text라인. 편집을 참조하십시오.
Aaron-복원 모니카

1
기본 그래픽에서도 투명성을 수행 할 수 있습니다.
hadley

2
맞습니다. 나는 그것을 잊어 버렸고, 격자 방식으로 일하는 것에 익숙해졌습니다. 관심있는 다른 사람들을 위해 색상 문자열에 몇 개의 문자를 추가합니다 (예 :) #FF000080. ?rgb세부 사항이 있습니다.
Aaron-복원 모니카

당사 사이트를 사용함과 동시에 당사의 쿠키 정책개인정보 보호정책을 읽고 이해하였음을 인정하는 것으로 간주합니다.
Licensed under cc by-sa 3.0 with attribution required.