# Looking for other integer lists with the same length, quartiles, mean, min, max, and standard deviation

I want to find at least one set, namely B with the same length, quartiles, mean, min, max, standard deviation as A. I have tried as follows but the standard deviation is not the same. The trivial case in which A=B is not my interest.

How to find B programmatically?

A = {0, 5, 5, 10, 10, 10, 10, 30, 30, 35, 40, 40, 40, 50, 55, 100};
B = {0, 0, 10, 10, 10, 10, 30, 30, 30, 35, 35, 35, 45, 45, 45, 100};
Length[A] == Length[B]
Quartiles[A] == Quartiles[B]
Mean[A] == Mean[B]
Min[A] == Min[B]
Max[A] == Max[B]
StandardDeviation[A] == StandardDeviation[B]

• Any random permutation of A will work, i.e., B = RandomSample[A, Length@A] Jan 28, 2019 at 15:44
• Related CV thread. Mar 5, 2019 at 2:39
• @J.M.iscomputer-less: Thank for the link. It is helpful. :-) Mar 5, 2019 at 5:34

Interesting Problem

Just deal with cases where aa = A (best not to use capital letters for variables) has a length that is a power of 2. This means the quartiles and median are averages of points to the left and right of where the quartile and median would be, e.g., the median of {1,2} is their mean, 1.5. Easy to adjust to where they'd coincide with values.

Set the problem up...

SeedRandom[1];
num = 2^3
aa = RandomInteger[200, {num}] // Sort
(* {8, 31, 64, 65, 95, 96, 112, 200} *)


Define the vector of B variables

bvars = Table[b[i], {i, num}]
(* {b[1], b[2], b[3], b[4], b[5], b[6], b[7], b[8]} {b[1], b[2], b[3], b[4], b[5], b[6], b[7], b[8]} *)


Define the linear relationships for Mean, Quartiles, Median, Min, and Max (assumes aa is sorted). We end up with a matrix of rows corresponding to each of properties.

meanRow = Table[1, {num}];
medianRow = minRow = maxRow = q1Row = q3Row = 0 meanRow;
medianRow[[num/2]] = medianRow[[1 + num/2]] = 1;
q1Row[[num/4]] = q1Row[[1 + num/4]] = 1;
q3Row = Reverse@q1Row;
minRow[[1]] = 1;
maxRow = Reverse@minRow;

mat = {meanRow, medianRow, q1Row, q3Row, minRow, maxRow}


Define the linear equalities, ignoring any scaling parameters for mean, and quartiles...

linearEqns = {(mat.bvars) == (mat.aa)}


If the standard deviations are equal, then the variances are equal, and if the means are already enforced to be equal, then the second moments are equal, so define the quadratic equality.

quadEqn = {bvars.bvars == aa.aa}


Define a set of inequalities to enforce sort order

sortInequalities = Table[b[i] <= b[i + 1], {i, num - 1}];


Then find an instance or three

res = FindInstance[Join[linearEqns, sortInequalities, quadEqn], bvars,Integers,4] // Values


$$\left( \begin{array}{cccccccc} 8 & 24 & 71 & 77 & 83 & 104 & 104 & 200 \\ 8 & 31 & 64 & 80 & 80 & 87 & 121 & 200 \\ 8 & 31 & 64 & 65 & 95 & 96 & 112 & 200 \\ 8 & 28 & 67 & 70 & 90 & 95 & 113 & 200 \\ \end{array} \right)$$

Check...

 stats[vec_] :=  Map[#[vec] &, {Length, Quartiles, Mean, Min, Max, StandardDeviation}]

Map[stats[#] == stats[aa] &, res]
(* {True, True, True, True} *)


With lengths of variables 16 or greater, it really struggles. Here's a solve for Length[aa]=16

aa = {0, 1, 6, 8, 13, 13, 14, 17, 17, 18, 19, 28, 33, 34, 35, 39}

res = {0, 0, 0, 7, 14, 17, 17, 17, 17, 22, 22, 30, 31, 31, 31, 39}


Using FindInstance[] I found a small example using my own A and B:

A = {0, 1, 2, 3, 6, 7, 8, 10}; B = {0, 1, 2, 4, 5, 6, 9, 10};


Q8[{a_, b_, c_, d_, e_, f_, g_, h_}] := {(2 b + 2 c)/4, (d + e)/2, (2 f + 2 g)/4};

With[{M = 9}, FindInstance[{
0 < a1 < a2 < a3 < a4 < a5 < a6 < M,
0 < b1 < b2 < b3 < b4 < b5 < b6 < M,
a1 != b1 || a2 != b2 || a3 != b3 || a4 != b4 || a5 != b5 || a6 != b6,
a1 + a2 + a3 + a4 + a5 + a6 == b1 + b2 + b3 + b4 + b5 + b6,
a1^2 + a2^2 + a3^2 + a4^2 + a5^2 + a6^2 ==
b1^2 + b2^2 + b3^2 + b4^2 + b5^2 + b6^2,
Q8[{0, a1, a2, a3, a4, a5, a6, M}] ==
Q8[{0, b1, b2, b3, b4, b5, b6, M}]},
{a1, a2, a3, a4, a5, a6, b1, b2, b3, b4, b5, b6}, Integers, 99]]


Using your own A is even easier. My solutions (divided by 5) are:

A = {0, 1, 1, 2, 2, 2, 2, 6, 6, 7, 8, 8, 8, 10, 11, 20};
B1 = {0, 0, 0, 1, 3, 3, 4, 4, 8, 8, 8, 8, 8, 9, 10, 20};
B2 = {0, 0, 0, 2, 2, 2, 5, 5, 7, 7, 8, 8, 8, 10, 10, 20};
B3 = {0, 0, 1, 2, 2, 2, 3, 5, 7, 8, 8, 8, 8, 10, 10, 20};


Using B1 multiplied by 5 gives

B = {0, 0, 0, 5, 15, 15, 20, 20, 40, 40, 40, 40, 40, 45, 50, 100};


My code to find these 4 solutions is:

Q4n[v_List] := With[{n = Length[v]/4}, Table[v[[k*n]] + v[[k*n + 1]], {k, 3}]/2];

With[{M = 10}, FindInstance[{
0 <= b1 <= b2 <= b3 <= b4 <= b5 <= b6 <= b7 <= b8 <= b9 <= b10 <= b11 <= b12 <= b13 <= b14 <= M,
74 == b1 + b2 + b3 + b4 + b5 + b6 + b7 + b8 + b9 + b10 + b11 + b12 + b13 + b14,
552 == b1^2 + b2^2 + b3^2 + b4^2 + b5^2 + b6^2 + b7^2 + b8^2 + b9^2 + b10^2 + b11^2 + b12^2 + b13^2 + b14^2,
{2, 6, 8} == Q4n[{0, b1, b2, b3, b4, b5, b6, b7, b8, b9, b10, b11, b12, b13, b14, M}]},
{b1, b2, b3, b4, b5, b6, b7, b8, b9, b10, b11, b12, b13, b14}, Integers, 99]]

Clear["Global*"]

equalStatsQ[A_?(VectorQ[#, NumericQ] &), B_?(VectorQ[#, NumericQ] &)] :=
And @@ (Equal[#[A], #[B]] & /@
{Length, Quartiles, Mean, Min, Max, StandardDeviation})

A = {0, 5, 5, 10, 10, 10, 10, 30, 30, 35, 40, 40, 40, 50, 55, 100};

B = {0, 0, 10, 10, 10, 10, 30, 30, 30, 35, 35, 35, 45, 45, 45, 100};

equalStatsQ[A, B]

(* False *)


Any random permutation of A will work

SeedRandom[0]

(samples = Table[RandomSample[A, Length@A], {5}]) // Column


equalStatsQ[A, #] & /@ samples

(* {True, True, True, True, True} *)
`
• I would assume this counts as the trivial case. Jan 28, 2019 at 21:06
• It is a trivial case. Jan 28, 2019 at 21:07