帶有不同大小的分箱的繪圖概率熱圖/六進制組

Question

這與另一個問題有關：Plot weighted frequency matrix。

我有這樣的圖形（由下面R中的代碼。生產）：

#Set the number of bets and number of trials and % lines 
numbet <- 36 
numtri <- 1000 
#Fill a matrix where the rows are the cumulative bets and the columns are the trials 
xcum <- matrix(NA, nrow=numbet, ncol=numtri) 
for (i in 1:numtri) { 
x <- sample(c(0,1), numbet, prob=c(5/6,1/6), replace = TRUE) 
xcum[,i] <- cumsum(x)/(1:numbet) 
} 
#Plot the trials as transparent lines so you can see the build up 
matplot(xcum, type="l", xlab="Number of Trials", ylab="Relative Frequency", main="", col=rgb(0.01, 0.01, 0.01, 0.02), las=1) 

我非常喜歡這個情節建立並示出了更頻繁的路徑作爲除罕見路徑較暗的方式（但對於印刷介紹還不夠清楚）。我想要做的是爲數字生成某種hexbin或heatmap。在考慮這件事，似乎情節將有包括不同大小的垃圾箱（見我的信封素描的背面）：

我那麼問題：如果我使用的代碼模擬萬元運行以上，我如何將它作爲熱圖或六邊形顯示，如草圖中所示的不同大小的容器？

澄清：我不想依賴透明度來顯示通過一部分情節的審判的稀有性。相反，我想用熱量表示稀有度，並顯示出一條常見的路徑爲熱（紅色）和一條罕見路徑爲冷（藍色）。另外，我認爲垃圾箱的尺寸不應該是相同的，因爲第一個試驗只有兩個地方，路徑可以是，但最後有更多。因此，我根據這個事實選擇了一個不斷變化的箱秤。 本質上，我正在計算路徑通過單元格的次數（第1列中的第2列，第2列中的第3列），然後根據它通過的次數對單元格着色。

更新：我已經有一個類似@Andrie的情節，但我不確定它比頂部情節清晰得多。這是該圖的不連續性，我不喜歡（以及爲什麼我需要某種熱圖）。我認爲，因爲第一列只有兩個可能的值，它們之間不應該有很大的視覺差距等。因此，我爲什麼設想不同大小的箱子。我仍然認爲分檔版本會更好地顯示大量樣本。

更新：這website概括一個過程來繪製熱圖：

要創建這樣的密度（熱圖）圖版本中，我們必須在每個有效地列舉這些問題的發生圖像中的離散位置。這是通過設置網格並計算點座標「落入」網格中每個位置的每個單獨像素「分箱」的次數來完成的。

也許該網站上的一些信息可以與我們已經有的信息相結合？

更新：我花了一些什麼Andrie其中的某些question的，寫信給在此到達，這是相當接近了我的設想：

numbet <- 20 
numtri <- 100 
prob=1/6 
#Fill a matrix 
xcum <- matrix(NA, nrow=numtri, ncol=numbet+1) 
for (i in 1:numtri) { 
    x <- sample(c(0,1), numbet, prob=c(prob, 1-prob), replace = TRUE) 
    xcum[i, ] <- c(i, cumsum(x)/cumsum(1:numbet)) 
} 
colnames(xcum) <- c("trial", paste("bet", 1:numbet, sep="")) 

mxcum <- reshape(data.frame(xcum), varying=1+1:numbet, 
    idvar="trial", v.names="outcome", direction="long", timevar="bet") 

#from the other question 
require(MASS) 
dens <- kde2d(mxcum$bet, mxcum$outcome) 
filled.contour(dens) 

我不太明白什麼是繼續，但這似乎更像我想要生產的（顯然沒有不同大小的垃圾桶）。

更新：這與其他地塊類似。這是不完全正確：

plot(hexbin(x=mxcum$bet, y=mxcum$outcome)) 

最後一次嘗試。如上：

image(mxcum$bet, mxcum$outcome) 

這是相當不錯的。我只想讓它看起來像我的手繪草圖。

Answer 1

編輯

我認爲下面的解決方案做了你要求什麼。

（請注意，這是緩慢的，尤其是reshape步驟）

numbet <- 32 
numtri <- 1e5 
prob=5/6 
#Fill a matrix 
xcum <- matrix(NA, nrow=numtri, ncol=numbet+1) 
for (i in 1:numtri) { 
    x <- sample(c(0,1), numbet, prob=c(prob, 1-prob), replace = TRUE) 
    xcum[i, ] <- c(i, cumsum(x)/cumsum(1:numbet)) 
} 
colnames(xcum) <- c("trial", paste("bet", 1:numbet, sep="")) 

mxcum <- reshape(data.frame(xcum), varying=1+1:numbet, 
    idvar="trial", v.names="outcome", direction="long", timevar="bet") 


library(plyr) 
mxcum2 <- ddply(mxcum, .(bet, outcome), nrow) 
mxcum3 <- ddply(mxcum2, .(bet), summarize, 
       ymin=c(0, head(seq_along(V1)/length(V1), -1)), 
       ymax=seq_along(V1)/length(V1), 
       fill=(V1/sum(V1))) 
head(mxcum3) 

library(ggplot2) 

p <- ggplot(mxcum3, aes(xmin=bet-0.5, xmax=bet+0.5, ymin=ymin, ymax=ymax)) + 
    geom_rect(aes(fill=fill), colour="grey80") + 
    scale_fill_gradient("Outcome", formatter="percent", low="red", high="blue") + 
    scale_y_continuous(formatter="percent") + 
    xlab("Bet") 

print(p) 

Answer 2

供參考：這是一個比答案更多的擴展評論。

對我來說，這個新的陰謀看起來像一個堆積酒吧，其中每個酒吧的高度等於在下一次審判的上下線的交點。

，我會處理這個問題的方法是把「審判」作爲分類變量。然後，我們可以搜索xcum的每一行以獲取相同的元素。如果是的話，那麼我們可以認爲這是一個交叉點，其最小值也代表了定義酒吧高度的倍數。

x <- t(xcum) 
x <- x[duplicated(x),] 
x[x==0] <- NA 

現在我們有實際點的倍數，我們需要弄清楚如何把它帶到下一步，找到二進制化信息的一種方式。這意味着我們需要決定每個分組代表多少個點。讓我們爲後人寫點東西。

Trial 1 (2) = 1, 0.5 # multiple = 0.5 
Trial 2 (3) = 1, 0.66, 0.33 # multiple = 0.33 
Trial 3 (4) = 1, 0.75, 0.5, 0.25 # multiple = 0.25 
Trial 4 (5) = 1, 0.8, 0.6, 0.4, 0.2 # multiple = 0.2 
Trial 5 (6) = 1, 0.8333335, 0.6666668, 0.5000001, 0.3333334, 0.1666667 
... 
Trial 36 (35) = 1, 0.9722223, ..., 0.02777778 # mutiple = 0.05555556/2 

換句話說，每個試驗都有n-1個點繪圖。在你的繪圖中你有7個垃圾箱。所以我們需要找出每個垃圾箱的倍數。

，讓我們欺騙和除以二的最後兩列，我們從目測知道最小值低於0.05

x[,35:36] <- x[,35:36]/2

然後找到最低每列：

x <- apply(x, 2, function(x) min(x, na.rm=T))[-1] # Drop the 1 
x <- x[c(1,2,3,4,8,17,35)] # I'm just guessing here by the "look" of your drawing. 

執行此操作的最簡單方法是分別創建每個垃圾箱。顯然，這可以在稍後自動完成。記住，每個點是

bin1 <- data.frame(bin = rep("bin1",2), Frequency = rep(x[1],2)) 
bin2 <- data.frame(bin = rep("bin2",3), Frequency = rep(x[2],3)) 
bin3 <- data.frame(bin = rep("bin3",4), Frequency = rep(x[3],4)) 
bin4 <- data.frame(bin = rep("bin4",5), Frequency = rep(x[4],5)) 
bin5 <- data.frame(bin = rep("bin5",9), Frequency = rep(x[5],9)) 
bin6 <- data.frame(bin = rep("bin6",18), Frequency = rep(x[6],18)) 
bin7 <- data.frame(bin = rep("bin7",36), Frequency = rep(x[7],36)) 

df <- rbind(bin1,bin2,bin3,bin4,bin5,bin6,bin7) 
ggplot(df, aes(bin, Frequency, color=Frequency)) + geom_bar(stat="identity", position="stack")