2015-11-03 58 views
3

我想在R中產生一個sankey diagram,這也被稱爲河流地塊。我見過這個問題Sankey Diagrams in R?,其中列出了各種各樣的產生sankey圖的包。由於我有輸入數據並知道不同的工具/軟件包,我可以生成這樣的圖表,但我的問題是:我怎樣才能爲這樣的輸入數據做準備?如何爲R中的sankey圖表準備輸入數據?

假設我們想提出如何用戶不同狀態之間超過10天遷移並且開始數據集類似下面:

data.frame(userID = 1:100, 
        day1_state = sample(letters[1:8], replace = TRUE, size = 100), 
        day2_state = sample(letters[1:8], replace = TRUE, size = 100), 
        day3_state = sample(letters[1:8], replace = TRUE, size = 100), 
        day4_state = sample(letters[1:8], replace = TRUE, size = 100), 
        day5_state = sample(letters[1:8], replace = TRUE, size = 100), 
        day6_state = sample(letters[1:8], replace = TRUE, size = 100), 
        day7_state = sample(letters[1:8], replace = TRUE, size = 100), 
        day8_state = sample(letters[1:8], replace = TRUE, size = 100), 
        day9_state = sample(letters[1:8], replace = TRUE, size = 100), 
        day10_state = sample(letters[1:8], replace = TRUE, size = 100) 
        ) -> dt 

現在,如果一個想創建networkD3 package一個熱平衡圖應該如何變換分析這個dt data.frame到所需的輸入

,這樣我們就必須從這個例子一樣輸入

library(networkD3) 
URL <- paste0(
     "https://cdn.rawgit.com/christophergandrud/networkD3/", 
     "master/JSONdata/energy.json") 
Energy <- jsonlite::fromJSON(URL) 
# Plot 
sankeyNetwork(Links = Energy$links, Nodes = Energy$nodes, Source = "source", 
      Target = "target", Value = "value", NodeID = "name", 
      units = "TWh", fontSize = 12, nodeWidth = 30) 

編輯

我發現這樣的腳本,在其他情況下準備數據並再現它,所以我認爲它可能已經結束:

https://github.com/mi2-warsaw/JakOniGlosowali/blob/master/sankey/sankey.R

+1

而不是關閉它,你可能也考慮提供一個答案你的問題。這可能對其他人有所幫助 – PavoDive

+1

好吧,我已經上傳了一個代碼並附帶示例並回答:) –

回答

2

我發現這樣的腳本,在準備數據其他情況下,再生,所以我認爲它可能已經結束:

https://github.com/mi2-warsaw/JakOniGlosowali/blob/master/sankey/sankey.R

然後此代碼生成這樣的桑基圖提到的問題data.frame

fixtable <- function(...) { 
    tab <- table(...) 
    if (substr(colnames(tab)[1],1,1) == "_" & 
       substr(rownames(tab)[1],1,1) == "_") { 
     tab2 <- tab 
     colnames(tab2) <- sapply(strsplit(colnames(tab2), split=" "), `[`, 1) 
     rownames(tab2) <- sapply(strsplit(rownames(tab2), split=" "), `[`, 1) 
     tab2[1,1] <- 0 
     # mandat w klubie 
     for (par in names(which(tab2[1,] > 0))) { 
      delta = min(tab2[par, 1], tab2[1, par]) 
      tab2[par, par] = tab2[par, par] + delta 
      tab2[1, par] = tab2[1, par] - delta 
      tab2[par, 1] = tab2[par, 1] - delta 
     } 
     # przechodzi przez niezalezy 
     for (par in names(which(tab2[1,] > 0))) { 
      tab2["niez.", par] = tab2["niez.", par] + tab2[1, par] 
      tab2[1, par] = 0 
     } 
     for (par in names(which(tab2[,1] > 0))) { 
      tab2[par, "niez."] = tab2[par, "niez."] + tab2[par, 1] 
      tab2[par, 1] = 0 
     } 

     tab[] <- tab2[] 
    } 
    tab 
} 


flow2 <- rbind(
    data.frame(fixtable(z = paste0(dat$day1_state, " day1"), do = paste0(dat$day2_state, " day2"))), 
    data.frame(fixtable(z = paste0(dat$day2_state, " day2"), do = paste0(dat$day3_state, " day3"))), 
    data.frame(fixtable(z = paste0(dat$day3_state, " day3"), do = paste0(dat$day4_state, " day4"))), 
    data.frame(fixtable(z = paste0(dat$day4_state, " day4"), do = paste0(dat$day5_state, " day5"))), 
    data.frame(fixtable(z = paste0(dat$day5_state, " day5"), do = paste0(dat$day6_state, " day6"))), 
    data.frame(fixtable(z = paste0(dat$day6_state, " day6"), do = paste0(dat$day7_state, " day7"))), 
    data.frame(fixtable(z = paste0(dat$day7_state, " day7"), do = paste0(dat$day8_state, " day8"))), 
    data.frame(fixtable(z = paste0(dat$day8_state, " day8"), do = paste0(dat$day9_state, " day9"))), 
    data.frame(fixtable(z = paste0(dat$day9_state, " day9"), do = paste0(dat$day10_state, " day10")))) 

flow2 <- flow2[flow2[,3] > 0,] 

nodes2 <- data.frame(name=unique(c(levels(factor(flow2[,1])), levels(factor(flow2[,2]))))) 
nam2 <- seq_along(nodes2[,1])-1 
names(nam2) <- nodes2[,1] 

links2 <- data.frame(source = nam2[as.character(flow2[,1])], 
             target = nam2[as.character(flow2[,2])], 
             value = flow2[,3]) 

sankeyNetwork(Links = links, Nodes = nodes, 
          Source = "source", Target = "target", 
          Value = "value", NodeID = "name", 
          fontFamily = "Arial", fontSize = 12, nodeWidth = 40, 
          colourScale = "d3.scale.category20()")