兩副牌之間的相關性？
我編寫了一個程序來模擬上手洗牌。
每張牌都有編號，花色從俱樂部、鑽石、紅心、黑桃開始，等級從二到十，然後是傑克、皇后、國王和王牌。因此，梅花二的數字是 1，梅花三的數字是 2 ….梅花 A 是 13… 黑桃 A 是 52。
確定牌的洗牌程度的方法之一是將其與未洗牌的牌進行比較，並查看牌的順序是否相關。
也就是說，我可能有這些卡片，與未洗牌的卡片進行比較：
Pearson 方法的相關性為：0.6
使用大量卡片（全部 52 張），您可能會看到模式出現。我的假設是，經過更多的洗牌，你會得到更少的相關性。
但是，有很多方法可以衡量相關性。
我已經嘗試過 Pearson 的相關性，但我不確定這是否是在這種情況下使用的正確相關性。
這是一個合適的相關性度量嗎？有更合適的衡量標準嗎？
獎勵積分我有時會在我的結果中看到此類數據：
顯然存在一些相關性，因為有多個具有不同梯度的單獨線，但我不知道您如何測量單獨的“趨勢線”？
您可以使用所有相鄰卡片對之間面值差異的香農熵來測量相關性的相對水平（或更準確地說，隨機性的增加水平） 。
下面是如何計算它，對於一副隨機洗牌的 52 張牌。您首先在整個甲板上循環一次，然後構建一種直方圖。對於每個卡片位置 $ i=1,2,…,52 $ , 計算面值之差 $ \Delta F_{i} = F_{i+1} - F_{i} $ . 為了使這一點更具體，讓我們說卡在 $ (i+1) $ 第一個位置是黑桃K，而在 $ i $ 第四個位置是俱樂部的四個。然後我們有 $ F_{i+1} = 51 $ 和 $ F_{i} = 3 $ 和 $ \Delta F_{i} = 51-3 = 48 $ . 當你到達 $ i=52 $ ，這是一個特例；你再次循環回到甲板的開頭並採取 $ \Delta F_{52} = F_{1} - F_{52} $ . 如果您最終得到任何負數 $ \Delta F $ 的，加 52 使面值差回到 1-52 的範圍內。
您最終會得到一組 52 對相鄰卡片的面值差異，每對都落在 1-52 的允許範圍內；使用具有 52 個元素的直方圖（即一維數組）計算這些的相對頻率。直方圖記錄了牌組的一種“觀察到的概率分佈”；您可以通過將每個 bin 中的計數除以 52 來標準化此分佈。因此您最終會得到一系列變量 $ p_{1}, p_{2}, … p_{52} $ 其中每個可能取值的離散範圍：{0、1/52、2/52、3/52 等}，這取決於有多少成對的面值差異最終隨機出現在直方圖的特定 bin 中。
獲得直方圖後，您可以計算特定 shuffle 迭代的香農熵為$$ E = \sum_{k=1}^{52} -p_{k} ln(p_{k}) $$ 我在 R 中編寫了一個小型模擬來演示結果。第一個圖顯示了熵在 20 次 shuffle 迭代過程中如何演變。值 0 與完全有序的牌組相關聯；較大的值表示逐漸變得更加無序或去相關的牌組。第二個圖顯示了一系列 20 個方面，每個方面都包含一個類似於最初包含在問題中的圖，顯示洗牌順序與初始牌順序。第二個圖中的 20 個方面與第一個圖中的 20 次迭代相同，並且它們的顏色編碼也相同，這樣您就可以直觀地感受到香農熵的多少水平對應於多少隨機性排序順序。生成圖的模擬代碼附在最後。
library(ggplot2) # Number of cards ncard <- 52 # Number of shuffles to plot nshuffle <- 20 # Parameter between 0 and 1 to control randomness of the shuffle # Setting this closer to 1 makes the initial correlations fade away # more slowly, setting it closer to 0 makes them fade away faster mixprob <- 0.985 # Make data frame to keep track of progress shuffleorder <- NULL startorder <- NULL iteration <- NULL shuffletracker <- data.frame(shuffleorder, startorder, iteration) # Initialize cards in sequential order startorder <- seq(1,ncard) shuffleorder <- startorder entropy <- rep(0, nshuffle) # Loop over each new shuffle for (ii in 1:nshuffle) { # Append previous results to data frame iteration <- rep(ii, ncard) shuffletracker <- rbind(shuffletracker, data.frame(shuffleorder, startorder, iteration)) # Calculate pairwise value difference histogram freq <- rep(0, ncard) for (ij in 1:ncard) { if (ij == 1) { idx <- shuffleorder[1] - shuffleorder[ncard] } else { idx <- shuffleorder[ij] - shuffleorder[ij-1] } # Impose periodic boundary condition if (idx < 1) { idx <- idx + ncard } freq[idx] <- freq[idx] + 1 } # Sum over frequency histogram to compute entropy for (ij in 1:ncard) { if (freq[ij] == 0) { x <- 0 } else { p <- freq[ij] / ncard x <- -p * log(p, base=exp(1)) } entropy[ii] <- entropy[ii] + x } # Shuffle the cards to prepare for the next iteration lefthand <- shuffleorder[floor((ncard/2)+1):ncard] righthand <- shuffleorder[1:floor(ncard/2)] ij <- 0 ik <- 0 while ((ij+ik) < ncard) { if ((runif(1) < mixprob) & (ij < length(lefthand))) { ij <- ij + 1 shuffleorder[ij+ik] <- lefthand[ij] } if ((runif(1) < mixprob) & (ik < length(righthand))) { ik <- ik + 1 shuffleorder[ij+ik] <- righthand[ik] } } } # Plot entropy vs. shuffle iteration iteration <- seq(1, nshuffle) output <- data.frame(iteration, entropy) print(qplot(iteration, entropy, data=output, xlab="Shuffle Iteration", ylab="Information Entropy", geom=c("point", "line"), color=iteration) + scale_color_gradient(low="#ffb000", high="red")) # Plot gradually de-correlating sort order dev.new() print(qplot(startorder, shuffleorder, data=shuffletracker, color=iteration, xlab="Start Order", ylab="Shuffle Order") + facet_wrap(~ iteration, ncol=4) + scale_color_gradient(low="#ffb000", high="red"))
