From bd52402fbace5a74eeb99b26f4c4c223782375fc Mon Sep 17 00:00:00 2001 From: Samuel Schlesinger Date: Thu, 20 Aug 2026 18:46:48 -0400 Subject: [PATCH 1/3] test: Pin shuffle uniformity and the one-row case shuffledIndices seeds its loop with a random bound, randomR (1, k - 1), so indices above that bound are never touched and roughly half the vector keeps its original order. The inner step then draws from randomR (1, maxInd) rather than (0, maxInd), which is Sattolo's algorithm and never leaves the head element in place. Over 400 seeds of a ten-element shuffle, positions 0 and 1 never keep their index and positions 4 through 9 keep it far too often. Shuffling a single index passes a reversed range to randomR, whose result is not specified; here it swaps past the end of a one-element vector. --- tests/Operations/Shuffle.hs | 37 ++++++++++++++++++++++++++++++++++++- 1 file changed, 36 insertions(+), 1 deletion(-) diff --git a/tests/Operations/Shuffle.hs b/tests/Operations/Shuffle.hs index 4ccf3e0c..2145e971 100644 --- a/tests/Operations/Shuffle.hs +++ b/tests/Operations/Shuffle.hs @@ -91,9 +91,44 @@ shuffleDoesNotAddOrDropIndices = , TestCase (assertEqual "There are no repeated indecis" computed actual) ] +-- A one-row frame has exactly one permutation. +shuffleSingleRow :: Test +shuffleSingleRow = + TestCase + ( assertEqual + "shuffling one index yields that index" + (VU.fromList [0 :: Int]) + (shuffledIndices (mkStdGen 7) 1) + ) + +-- Each position keeps its own index with probability 1/n under a uniform +-- shuffle. Bounds are wide enough that sampling noise cannot trip them, but +-- narrow enough to catch a shuffle that only permutes part of the vector or +-- that never leaves an element in place. +shuffleDoesNotFavourAnyPosition :: Test +shuffleDoesNotFavourAnyPosition = + let n = 10 + trials = 400 + samples = + [VU.toList (shuffledIndices (mkStdGen s) n) | s <- [1 .. trials]] + fixedAt p = length [() | xs <- samples, xs !! p == p] + lo = trials `div` (4 * n) + hi = 3 * trials `div` n + outliers = [p | p <- [0 .. n - 1], fixedAt p < lo || fixedAt p > hi] + in TestCase + ( assertEqual + "every position keeps its index at roughly the same rate" + [] + outliers + ) + tests :: [Test] tests = - [ TestLabel "shuffleShuffles" shuffleShuffles + [ TestLabel "shuffleSingleRow" shuffleSingleRow + , TestLabel + "shuffleDoesNotFavourAnyPosition" + shuffleDoesNotFavourAnyPosition + , TestLabel "shuffleShuffles" shuffleShuffles , TestLabel "shufflePreservesData" shufflePreservesData , TestLabel "shufflePreservesColumnNames" shufflePreservesColumnNames , TestLabel "shuffleSameSeedIsSameShuffle" shuffleSameSeedIsSameShuffle From d5752606c0ef41a9b1756bee8cfa9007d506f953 Mon Sep 17 00:00:00 2001 From: Samuel Schlesinger Date: Thu, 20 Aug 2026 18:46:48 -0400 Subject: [PATCH 2/3] fix: Use Fisher-Yates for shuffledIndices The loop started from a random bound instead of the last index, leaving everything above it in place, and each step drew from randomR (1, maxInd) so the head element could never stay put. Walk from the last index down to 1, swapping with a draw from randomR (0, i). The loop is empty for k <= 1, which also removes the out-of-bounds swap on a one-row frame. --- .../src/DataFrame/Operations/Permutation.hs | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/dataframe-operations/src/DataFrame/Operations/Permutation.hs b/dataframe-operations/src/DataFrame/Operations/Permutation.hs index 155e5c37..531bb024 100644 --- a/dataframe-operations/src/DataFrame/Operations/Permutation.hs +++ b/dataframe-operations/src/DataFrame/Operations/Permutation.hs @@ -191,14 +191,12 @@ shuffledIndices pureGen k shuffleVec :: (RandomGen g) => g -> VU.Vector Int shuffleVec g = runST $ do vm <- VUM.generate k id - let (n, nGen) = randomR (1, k - 1) g - go vm n nGen + go vm (k - 1) g VU.unsafeFreeze vm - go _v (-1) _ = pure () - go _v 0 _ = pure () - go v maxInd gen = + go _v i _ | i <= 0 = pure () + go v i gen = let - (n, nextGen) = randomR (1, maxInd) gen + (j, nextGen) = randomR (0, i) gen in - VUM.swap v 0 n *> go (VUM.tail v) (maxInd - 1) nextGen + VUM.swap v i j *> go v (i - 1) nextGen From e2259a824fa94aea4d1a7ad46c1881cb40e617b5 Mon Sep 17 00:00:00 2001 From: Samuel Schlesinger Date: Mon, 24 Aug 2026 08:29:17 -0400 Subject: [PATCH 3/3] test: Check shuffle uniformity with chi-squared tests Replace the fixed-point rate check with two chi-squared tests at alpha = 0.001: one over the full permutation distribution (n = 5, 12000 draws, df 119), which also catches correlated positions, and Knuth's frequency test over the position-by-item table (n = 10, 5000 draws, df 81). Seeds are fixed, so both are deterministic. Fisher-Yates scores 114.7 and 83.4 against bounds of 172.4 and 126.1; the previous shuffle scores 137088 and 114988 on the same procedure. --- tests/Operations/Shuffle.hs | 81 +++++++++++++++++++++++++++---------- 1 file changed, 60 insertions(+), 21 deletions(-) diff --git a/tests/Operations/Shuffle.hs b/tests/Operations/Shuffle.hs index 2145e971..b7f71c96 100644 --- a/tests/Operations/Shuffle.hs +++ b/tests/Operations/Shuffle.hs @@ -5,11 +5,13 @@ module Operations.Shuffle where import qualified DataFrame as D +import Data.List (permutations) +import qualified Data.Map.Strict as M import qualified Data.Set as Set import qualified Data.Vector.Unboxed as VU import DataFrame.Operations.Permutation (shuffle, shuffledIndices) import System.Random (mkStdGen) -import Test.HUnit (Test (..), assertEqual) +import Test.HUnit (Test (..), assertBool, assertEqual) testDataFrame :: D.DataFrame testDataFrame = @@ -101,33 +103,70 @@ shuffleSingleRow = (shuffledIndices (mkStdGen 7) 1) ) --- Each position keeps its own index with probability 1/n under a uniform --- shuffle. Bounds are wide enough that sampling noise cannot trip them, but --- narrow enough to catch a shuffle that only permutes part of the vector or --- that never leaves an element in place. -shuffleDoesNotFavourAnyPosition :: Test -shuffleDoesNotFavourAnyPosition = +{- | Chi-squared statistic of observed counts against a flat expectation: +sum over cells of (observed - expected)^2 / expected. +-} +chiSquared :: [Int] -> Double +chiSquared counts = + let expected = fromIntegral (sum counts) / fromIntegral (length counts) + in sum [(fromIntegral o - expected) ^ (2 :: Int) / expected | o <- counts] + +{- | Every permutation of n items is equally likely under a uniform shuffle, +so the counts over all n! outcomes are chi-squared with n! - 1 degrees of +freedom. Testing the whole permutation, rather than one position at a time, +also catches a shuffle whose positions are individually uniform but +correlated. Seeds are fixed, so the sample -- and the verdict -- is +deterministic. + +n = 5 gives 120 outcomes; 12000 draws puts 100 in each on average. The bound +is the 0.999 quantile of chi-squared with 119 degrees of freedom. +-} +shufflePermutationsAreUniform :: Test +shufflePermutationsAreUniform = + let n = 5 + trials = 12000 + observed = + M.fromListWith + (+) + [(VU.toList (shuffledIndices (mkStdGen s) n), 1 :: Int) | s <- [1 .. trials]] + counts = [M.findWithDefault 0 p observed | p <- permutations [0 .. n - 1]] + stat = chiSquared counts + in TestCase + ( assertBool + ("chi-squared over all permutations is " ++ show stat ++ ", above 172.4") + (stat < 172.4) + ) + +{- | The frequency test from Knuth 3.3.2: each item lands in each position with +probability 1/n, so the n x n position-by-item table is chi-squared with +(n - 1)^2 degrees of freedom. A larger n than the permutation test can afford, +to catch bias that only shows at scale, such as a shuffle that leaves a +suffix untouched or never leaves an item in place. + +n = 10 and 5000 draws put 500 in each cell. The bound is the 0.999 quantile of +chi-squared with 81 degrees of freedom. +-} +shufflePositionsAreUniform :: Test +shufflePositionsAreUniform = let n = 10 - trials = 400 - samples = - [VU.toList (shuffledIndices (mkStdGen s) n) | s <- [1 .. trials]] - fixedAt p = length [() | xs <- samples, xs !! p == p] - lo = trials `div` (4 * n) - hi = 3 * trials `div` n - outliers = [p | p <- [0 .. n - 1], fixedAt p < lo || fixedAt p > hi] + trials = 5000 + samples = [VU.toList (shuffledIndices (mkStdGen s) n) | s <- [1 .. trials]] + cell p i = length [() | xs <- samples, xs !! p == i] + stat = chiSquared [cell p i | p <- [0 .. n - 1], i <- [0 .. n - 1]] in TestCase - ( assertEqual - "every position keeps its index at roughly the same rate" - [] - outliers + ( assertBool + ( "chi-squared over the position-by-item table is " + ++ show stat + ++ ", above 126.1" + ) + (stat < 126.1) ) tests :: [Test] tests = [ TestLabel "shuffleSingleRow" shuffleSingleRow - , TestLabel - "shuffleDoesNotFavourAnyPosition" - shuffleDoesNotFavourAnyPosition + , TestLabel "shufflePermutationsAreUniform" shufflePermutationsAreUniform + , TestLabel "shufflePositionsAreUniform" shufflePositionsAreUniform , TestLabel "shuffleShuffles" shuffleShuffles , TestLabel "shufflePreservesData" shufflePreservesData , TestLabel "shufflePreservesColumnNames" shufflePreservesColumnNames