From bce13d69dd5a6ac74cc73a3bed57a0131d0b7b59 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 8b4110b0ac326f2cc21f3f2d8b46386abec3152b 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 9c97df9e..251e8b2e 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 854c1de1bbd2f5bd4d7a9eb3d3b62f68f5c457b1 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